From 894f0554597dbb4d93cbdb99d28c6be6ea25ccd3 Mon Sep 17 00:00:00 2001
From: Emil B <eb@concordium.com>
Date: Tue, 2 Apr 2024 15:14:22 +0200
Subject: [PATCH 01/81] Bump base.

---
 concordium-base | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/concordium-base b/concordium-base
index 825fab04f..ac9cb74c6 160000
--- a/concordium-base
+++ b/concordium-base
@@ -1 +1 @@
-Subproject commit 825fab04fb78445c9f1cdcaf4cb9dae33f3b831a
+Subproject commit ac9cb74c6f206af7b1973c82ebc6973fbe92f0e4

From cdb52ac6fcc85e376a9722905b8e1203da502074 Mon Sep 17 00:00:00 2001
From: Emil B <eb@concordium.com>
Date: Tue, 2 Apr 2024 15:15:26 +0200
Subject: [PATCH 02/81] Work on covering new account version.

---
 concordium-consensus/blb99190-530.dat         | Bin 0 -> 36576 bytes
 .../src/Concordium/GlobalState/Account.hs     |  44 ++
 .../GlobalState/Basic/BlockState/Account.hs   |  33 +-
 .../BlockState/AccountReleaseSchedule.hs      |   1 +
 .../GlobalState/Persistent/Account.hs         |  65 ++-
 .../Persistent/Account/StructureV0.hs         |   2 +
 .../Persistent/Account/StructureV1.hs         | 464 +++++++++++++-----
 .../GlobalState/Persistent/BlockState.hs      | 146 +++---
 .../GlobalState/Persistent/Cooldown.hs        |  18 +
 9 files changed, 593 insertions(+), 180 deletions(-)
 create mode 100644 concordium-consensus/blb99190-530.dat
 create mode 100644 concordium-consensus/src/Concordium/GlobalState/Persistent/Cooldown.hs

diff --git a/concordium-consensus/blb99190-530.dat b/concordium-consensus/blb99190-530.dat
new file mode 100644
index 0000000000000000000000000000000000000000..e4570989e20dbb12f52cc6ad875f51f0bc8b3aeb
GIT binary patch
literal 36576
zcmd41bC4z7*2Y=3?dq~^+qP}nwrzFUw!3WG=(252_r33Y5p!cEX6_$f#H@(SC-*)(
z*KhAU=VWF)u>b)66_7yx*8ka45T#qCX8Yx~+L&{&VLDrg*~+h)`JpH!x=gJHB*QFJ
z9Q@DFe;okE|G$mT;M?TyjC`1I8Gk9}AfFfeWf<ZvMWGf6w!=V89wLqX*8d3@l<LIZ
z?CwUCzK8^vWQcYHz5{X;YYQXmN}DG~^3ycP%#cuKsAtPL<erqd=rNb%$-jy;b7T;p
z?bnY@z<(wL2mtu!kW64!oIgg+PRI{<jV5b$?;(USl8(^9VhJKNj@#`4=D$w=H~XK9
zL<SE7egF&r(EAVV|Ev6OkN<z1NALeO`F}hAKP$udw*s#J)BaC^_>T_yf7<{4VFO7-
z|I-%yw*nRXqy69i#6O?^M;>CyKmGsC0f2=4&lqG2V-s6v3ug~Kdq+FhKMhBk{}Tt0
zcDqo@khYRcnqm|!S6&4_U>+@(=G+dNFU!e?j$Ng0t#ZQm>WOvz&Upj1K{(u*v`eM0
z=#Z=LQ?-y6P9|rfVKqCO@uLN+dEKCM(@$Q4N%|HEIax>Tu*wHi2ZYKONV1^eCJrir
z6atitW(YxH_`q}Vjh_psNdel}bAQeax(b-I47Brl(O-46kD$Bl&y?}fd5!7DiP~*$
z+Y*kFBcTm+dq4_-K^9cU`ZE2tjNZ8zM06M%vzE){Srr6D4jJ2;c|G6{Q+xLcdcg@X
zs<5$O$j}N`73ux;1c`^~M)IQolJTDf0@@-R%*s{7<DFHjq5W+VpUuR#Di#t`+wXY*
zhqD+%*>8n}dwP(T)p{i*e<GRNmiUtXns9HG)(sD=uatbL8~;k;$VlsSobga^c#lt+
zPuA|gYto%cGAb#)PMUe*tz<*=kVgo7fij3qh$c_*d55|WPzn_eB1wDPdptfYL@|Ki
z^II0$2MFic&ZWI1`F+;RQE3kV&q=w}XyR1@ND0)`=9FZlgl+ONp@6|OL#s-@6W3vW
zz7@*r)__D99ktDPbn)urZDqoguqo_~!r9+gm%;38Ct5jxfisVMNk2N5C2rI8oSsOY
z@dAGGh~sa6pTk#;Ne#*z0Ki{}p)?b(_gK(w7o@4k3&hW~#?B(R^Pr`62Emd`n5@v_
zvP>JVde5?+JCVj4M`fp<kda;D8mk5l@TS<X*%Rjnxof9-v0_OVAm7SRoz1op65+{U
zg1tuW@Zk&;&wHZwtQ0(S?RR_NfteUa>fT3&yLVDVpgNy{kvIYUh(h?Hl$0CpX%~*u
zS1QCFb}>DAA$`Z)E$N{kIC0iU6pq*H_Hzv&A#-*7JGgw*gPv4JcJ7`~(1fmgkt4ai
zIZ(v&Qq>$Q2_;~y5B1by%eejhou7kUMnh83%JHURn&L<i1#J7XZbb4MU_K46-m2#^
zl2IAgQ~y`Avv^FU7xTVA0hlHz)zG`9IW@Nd38VEA5OLKjH;xlW;cJ;_?0#O_a|BQ?
zi^n&=5vmL9JFILVOv~O_bRiAzlf>_MloK&^)*j+O?;-s8v831Ik{hSDMt_5G!R$uO
zskK|^btM*EzN%85OqvkO=Z42zm|m1h@k6Qo9>XhuIF<^7m>~PI&4=~*^dEh2dX}((
zTt5g|M>@ymXVVFtYdjvFQPPp7?_*U?a*eTUjD8`4rt37wJ#*Ctu6_f75i2bjPqa|5
z&n!6EVoF&Dv2CUOY7)+s^E~X1@1txFI@PP^37&#Q$(y5<O~J#wh_C1W7?(^x)LTRa
zYy@OD%1}UDWz??=gH8}r%AKAaS!AY3Y9tnx)QuX9GQ3rUeMg^8S9{f7$L0}ZzX?c}
zLR(N(cbo?__U8|o(K1~2_w9m+4YG_9v*H5j1Or_XQu{^g`=C<Zd+J}L(G3BzgRuPW
z13jF{L%h*#%ih1Ab}UBV+2Hz)n%e~K3Dz=G?2hVtrsk??3}-{pT!YKK9L#eoer|)!
z#NF_ovhCTnTU0{wRuU9HPV|6na%(W#3cMcfz=R6nhr~$MD^w3|R9*@5lQJBgW$rCd
zoH-{TI5&utw0L``F~(1FktqSdxUQ1h&-<A=WS4yO-VC8jP*FOtF1l-lK{VW%Cz<EU
zh$w)jF<{MV2qc_PAGLl<j}gidB&yHjMnSwd&25X<wLRBT7($9=B<~?ihm*~=?bQHb
zrD9QhqLV4Zw@c|ubnQGCWz;%RK3SN(4siZ$1Y@a>D##N>258QsKJk<+Ek1FlE=m`t
zO&Vcx{t}_(_@d;pq1Ou&kBdC4)DR0o*;-knW3I0es#?ZXs5NWnnk=}dH`O^{Ee=P8
z!`&{&FVVS>f9#YRFvwb2>9<lGz6xlaC8kZFkKb_B2HT|5;a2~zpeRa72Ow~BKjo50
z&s-c%Jz?lkP<WDLdCZVginF-$A7~KVzSbklNNc}&R`;&qu_I*SAq36URuA&A2G&AP
z$XlbKt0Sg?tet&f%1&_EzT56+kl`7mQx?#b<|*S{`T`KlNS=ag<XA-qWZRMrT%yGA
zzhN?kz^koNnp7h!nK-dbe=SAdzgg#c&5xRz4E?=FCn3Li#h-mc6M(&WIa#}1S*DA{
z%`f#?YNJe*!vX4=VzLHyAYB?!w+Lr4tc_9^qo2nRgM#0q7rLDy|G5A&J=QlTVu>P4
zz*MwU=|+`Q=uL;<T}Rt>qE#N7ay{-*!K>7Oxug3O$!Dz_4^C}6lj9>5v+I1c3vp@X
zz+fb9poIF<=K`Y>d?D5}94N>qD9$MSeXZTGc`vGoTs0aP7x@y~YuRw1iuX<YDf~AE
zv1J%P4|mLP!)O$Pd^xko1CAvXSnYfy<t&G>3loV=z>Y`UN?QZCzdKPD_zl}_yxJ90
z*Z2~{Lj_%|!`w9LP@%eZBj^UcdAM4Nk4yxqS1&zm50+#o0V=p1YqfDye-X{<BZ17m
z1+uS6a4u+khM_i=wZ{8fnPv=u(<WQ>mZ?X$Krlq?F)0f8_vnU*x?!y7y^63hAZ4sJ
z=GmG#LzPYtAOaZ@k$ta6Q~C6h7|vgR8FJ)lRxpm<dGFC8&d#4@5c`iFKk%aCVf|32
zYiEr=U)HtKS?&kRJ<G&_UG;Mu_HN96zhlFKv1aD#+`5-Fudpq)+;6Y8B9_F|MirLj
zDxEmlPkG}FBntQNwCW&&9syTg%%)s1zxff(7M*?)8Uf)*so_7&_5r(cn*4Nk1Uc#!
z-E25lgV!q2vNdYN1$NrS$quxAGXv_I3RO=^RRc5U6=k5J8gm(F1emSZNg2aie&C<{
z<7)g0kasg@@UU;Sor!DkP;n`XG`8(Ry3%IgohBaR=bGs^a|mto#0(wL7_fh?YqzV)
z8k`R|Y)=FMP=BJqYKE7wbriShHJaAPpZo5eWdlc~5*Q}@_7V$KV914?-jVF;V0T_T
zv-M0B@d<#`sD$NDxTvj>#wmJtiPt-s#7hVl*fjGhe-pP`RYnIz{tb5Z@r1f)YPF{%
zrw7x38LRXvf@LXO^&pg8y9~1d;M;*A4isFPsGJ<rnd5qOFgYkv)`tU>Lme)Ih2?j6
zO{lDTTCu1g(6~WV@tt(=8n8B{th}caJ23gi>S6okaSz#=Rq0vpw47MJVRqMjA$zD$
z_Bn5UFBL5@(3hv#w3Ro#ew3h;3j(Lws_}t6%Z?agrp#70TX4gl?bC84u!I#Ys}{^4
zTn<Gq!;a@YU*=XEVF3}0xeN%ahE~trE^P{1f<qs3q**}nHuNxIdr3supozf#l2vHa
z2Vj18lBZh%TwtLnWz(y%l8l8pf!LI3NFwg12Hs{i%KiuRk>pyB4m|L#S;2{J)}?Ro
z9Ucq0Q-#n(0Vo<sX~}_(BiZ}d_N&)i^3#1eAqdX^dNdsy*tt};c=0N9#2P~HnDBGX
zwFpk+U#slh+yb<X4Jf=2yD9yL6U7{IzNNqp#{eA4eCK{t^Zk0#gD<41RIk0<M};WD
zY>CEnK$$j(dA0Wpi?@l?KXmFDxAqQOI49i`sNb>_^AP4h#S~wdUYL-3g@7GI+5zGa
z`<j2|b<5eD`ovfS*(;!&(!yQcaB)eaNd(FFhS^yZDv$~tL?q5D%7s5wfe+2TAoh5R
za;v1Q$bRd~3r56NM7md7Oxv0qS5ldgyZ5v|aP(Q`Z>eNSnZt728*#7vxO`zt*a+Qr
zj<lZ3UT`}0q~a@dwOjBYlZIQhlDqFw>1?$4U9g)r%UNWoFbWP9!aysqn0F@u7SEOW
z!w^FvUg~g{Fi&9@5btza6G=qixpnrmV^Ed3<Q~c3cdI--QhE`I!B??+lO;wm!QN$&
z2<pXEdxACjuNjPPPjjcARQlyOQ6&6ax{rD4k{Z8(*r0VA3d9oi=$w3=+J+_7J6*&_
z;l&`Q%V~tbk4x=qelq7b;(3EFQTf9{uhLjxdfztjYt<6SRTr`ik^l}da)%$F9MM^=
z>4+2)ak&^ZBx1$$mx}>q6KF<HN$}uJS`S|JNaeQzTrJ?tHN?Hu?VW3kVqP2%<rF%u
znBOgm-Q2?V1EETS-id*jMX`68zU+rnpb0xBtT<^n)ECe><Wo+)f0>rYnkL9UK4s`(
zlCDYsX5P4twZ4|L(0`l-wr0(Bn>m}<+NYJczxzb>P*1_P4H#42w#*J#+H?rYmakz$
zOH_x%zm>w81e9uwOco$wdOdH8*h)lu5LCqNdyNaDa-#5^Hg6ydMN)w<?yOBBE_2T;
z%9d6e1W9g>SOL{-r{p|jYLu!|8UZ0@52)7EPE1Q^8E|E*zROjr>Wac&`k8IweYyY_
z+>D6D!e)o$^gvP*XkZFLdv}q0z(gn{AUaiY(ycdpLLYJYMjd%ZV_;;rvJI4}DSnV?
zsKCI1!ZJ4C$J*zD6tC}Si*27XboHCi*2e<qJT6wqXvF=TujFY#I{SgN508qZbZcpT
zAnqP0BRv3nTt@>jo{eUoSIsC&=)f?JuXjY+Yf$9kC|rds>n2*IGoz*tVk=eS01CQ}
z@+&7{8D4>ly8#N~@;L;?vicyeK24OfZ#CX)V3vFzM5P44_uVHYtkeP&!K>twa7o!t
zBTT?5a8F%FYlvVh``Oe2QF_F>PdKr<9Cz!EgtaHU@_Mb5J5XYo_G_TJh<OcGRJsh!
zeu<ySQOj8Kvjc_MtuW(WNtRT&vJg3S(oY9r53ZyG+hSPi6DY5&0-;eQR)5ry4Q-Zt
zpQPy~UXDr`^TpgXFbTVODr~dI$4ou%@du;tjVBD_!uD^WRp}m<UwQI`r8a8s6uJrd
zbbSQml8fc&rBHG7!S^N{5_pV|8owf5e*A>JM`A>#zz*v7V)q47<6KVy)MbY;G$|jp
z5zgD(?z>j2j{Y4t3VS9JDy6zM_q3(!d~v|tVthP9f49UqSG04W_`bxGfp0)FoKOql
z2kuIR+IloQ34;U=gWsd&eAHvWo}$ud)JWP((rQo+UU!u%*8Z`$D;{+MpUM#W0+-2#
zxk#b{#D3&hSh7edV+PtUhP8`a0B76(b38w}lC)g%m5RIP96;U7vUc+|KIo%vJg5xK
z`e-Hz%6!rPy*FdOK9r1ScScwE2QvOBtR%E0>=w@1H!WT3-e6DpH&HyJl4fe&T9nIv
zhH>PEB8JM@wk9}lxASzPSK0^U$FUBY6lLJ3z;uRXJ;B9=9=){x3NQ&26VTZctZ$Qo
zzi@eTrOv%qTSbts#_x-3!+SIr68m5Wz2O04Oq`}h6H?S0izR$T<|cu?<Y`La<AV}6
zY8p;^A*2OYM9a9ic3M_iLLX&qqR{5zeW3AvzGW@b80n=v(x2vbi0jowCkVwe=ckz%
zjISkz_8;J$VxCS30{v+Vu`IRd#gQHCwRx>IY~kcL<;Hd0kuW73$5uJ5#^yN040K$(
zp)heS=Y-4?vBO_QO$(>uafFtZ?K5Hi>i0zb$%@kqU=e)m{vQw7B!aLKv9D`liZGPn
zU&k7BB}79}R{?h?1@SHAOo4?vr4dZC$dFo?74Pbgq{sBq8LhhdqLOD#r1p1a&X-V#
z0oe$@dO~!Jl+_eVEq6}cSD4P)S$6@cz<y4XVgWn2hMr_Bs-hV(q(H@>nTH>4JoAg(
z(3c&e8fbUyS8SSQM{BKCr^q(_4%d9#J3!^aFI4f^mrg<J)I&Byg;oh&1Nm`d5YF>(
zy^X<+5YKznk^1ZG6rLGF92~`Jc<x+zr0;c=ZPaKI!oW}OO@Q%YsS}U+wWFk0MLNZ5
zvRd%K6Cp{EK$VFQscO$E^@D>I>Hgu{?0z*QsOJiF!-_VF+ouq@HfT*tqTjzlU5mL#
zA_vXf5SPfLAHMJwmRv<S0RGpq3#{;<A>-^c5$K{inVipQawzO(@t6?0Mfuosco7S9
zRi~>{b@UBgJwSSmN)ccF7>q@~3~H{O7-f_-qZ}J~417wlWG~lQ$PNybx*;;bFkIX_
z3(6f$+k0jb)JvCB%&0%75oxu%ln}Cn5v2w#69oa7oxN0w=><{5Pf{?A&tD6DFUvo+
z;ZQs-R0AC^&{yuTC=KmaOwnYX>Ac2IqBR0<_x`-Y|FIqaWfA>#BL8nJB8ETR|BC-V
zT15H2ZEM26i13$YqXa$+Z~1scDU*3PnE}gRLY`JZlKm)$PCnH5?j_|35S^vpeEVaF
zFU;l#ivY8v0)ai*l@TPpFp;X!R1YICoX$!G%fp6<EUCY1Lvt@h?r3O1U;@&)L?8EQ
zs#^9#NE0lS(vP@^#n~Ff#+~{UG{~Hzy@h3G&(0)33Uyi0ZPW#wN5N9UGp{*wE~ZoY
zCR|5&*?5=ezIUEGt}}H%qs4Zk&4<u)L*o*<bxYmK!yBhd2_2IWttSTkr%Y*QNDPKt
zKkF5VUT5wQ-DjOftanT}d;vv_hb`>jV`6QhC7fXlg7yPOJHs(-`<(V;RFEPxjUyzH
z87Ac+bUt-omM3rkbCwJJ4E6{u%<*h~6p^$P!vTc*SVL0Ij%D#zIc)Z001b!rPDnMv
zn`Io<eMW)=Q?6zaLKY-YnGP^ePx#Ji(ae>~amLq|<ul|zdvY}L3!!VPma`eekyYnp
zUv()eTzEFcIp|SYNDA(X+f3F&JvCKO(U)L3LSGS<7k4-rOPNK$1tHSf1s3YhAq}^V
zShD6Gr7T{$h!n(TRzx6uK8DpVW@GBM#=u<C0CA#t(GjM3F99d&JMY5S;1>rLECE1!
zgP_$K#97g{P`#6(f5D{<kCOIOqQ8+d@Ut|vnHjY+5(1QU=k~y1dAc?aH6nK>r9aOj
z9!~1Pph)<JocNcHZ&%>KQj1efKh2Q$tkjFx$1m*9VD=5*j!Y%Kb%370Z!LB-35Sny
zrQDi#1JXo&sd5iW*BBL`6TD=AmV_3#suMU4?$nH!;)ArWRurHypH2tIj;-J|FO^Fe
zD7rT+a<>rM+uoYJH)PI$DQ?%VmRy%O{~)zv4LEHzJ2qZFNaohDz6a;|$_4~wnNta2
zR&LcR4Q*U>4wK(tgGAtz^5p`>-enhbP#S^oyX!B8C{yQNL4ryy9!wb}<x^`5Ah=wA
znN$)w{`FPn{h-i{)f*{%@j&&y@g7<D{SNVpLi%(kp!#*Xmb>#Son1d1B7nM*Ty0r<
z0{WQV>Vuk>&P<0Mz?QCcG@;{Ltfj8$Tt^A|Zk-SCIS4jE1L`D=<|01Duuj0>slnwG
zXBbZ$-pq2!KhNYd&*L?Q7N&KnP?4gxF}Rjei_?Mc({3Oz3aX+!6-UoN&)n-)a73F$
zCP6tW{#;Dp1-kE>{)Nqak)Vv{iN&i;jS~tctj4Tnn}{x+X31VR;*r#cly-!y#zfdl
znP$|yXbzE-x$VN!fcJNrESS?Vvhg>mj=@s+XRBm)$Y{adkC0kluIx5l7VPFCD??2B
zDe1dh49nJF%G}$rc%>Q+sUHbO?(N#OeJ?`8xcUbG#>14qVZS3nwj|>a*Je2R$%lL1
z1jx5Q1*PSr$#03Un`&qI2xoSK_6XKD520$ph_XOd;f+{26ZsA|{7qgzqu2D4%`x`0
zRny}5o5+QZDJvh;bG1{Vu}9WIrE{}(Cc)^)yC~E@ouQocR5THu@U<W{Kk}1iDRgVJ
zQEijytufB_-=k2|f=Qzyr*)&KrEfN5&dQ}dH9N#{n=kjbpnP~FglK}sB{4}GIBs2Y
z9Yw#iZF`-n%4k3mbcHRa2>J#0DaGyHt5NS>?#~T7uj>aq6z{&Mus`AF+3+GSsJQ`#
zD~4_=+Z!xUeO?%*$=rqJH5TR>_QI8^7ehoiPi-Grxf2&Gx)Q^B-1z=DZPsN#SDEoG
z!9#pCA%+RN)<NHe5Mij*m`gGK#GK!YJm*(|tm;UdmD2B1)kaozS65mFoL=>DO4UQG
zcq{Y_DhMj{I(nvABC-*MHzKAES8@JrxR)i12RdN_r>~?`Kz>Y?pM5z+rU3B<1BAZ7
z*;fYc2uxas0ZOuKeRXG&<tGI0mGuU|9!E2|kO`-L7R#v5m}(_|9vpaOOc;b^*d3|u
z*S0%$rA(pF9)~&LPiKeEwrwsT)I5+LFiPkA)2wJ2&ArSmm$vg5h>m8%<TKC6@!A*w
z<hHddeZwqFMYua#yv65ca;+5?U>K{uElJkb$}ZT;Koh@`(t$jnO9`8C$>&sDyNfCg
zP*+eQGY0_+>2l);sW+7_A2eEk@^K+<IdI@07Ee<FzPX&G6Wa7kyG1)w{U<&g-&O6&
zqau{SL%UDXIR@T^GUr>nLup8O*VQ>s2^zVpOo*+;Z?+Z0xlBA!t@rtsEhOg!z<#d^
ze0fY!Ie_L@G>26Q>y0JAzUPq)S?O_syzYr@IDJo}pX1}LJM4?j>3^xrG{Py<`kbH%
zXNmImmG^$Zl^DD+-TG7liXm*Lq4t91M5zi)in(ZUCcCl2pXeQ4pj3kr@jlqfJu)9#
zgfQ!b`3s&bBf~r95z7#Pb@jb@aWNQZVQ4ImLGH7ECTu+mkLBGUlbS^qtf4T~U-3`5
zpwq&wzZU=6ZcCz!c3RZ-)SQapc7v5dm{rE>(iZ0&?PrrCM~%o~+9Yio>4c#KPLbGT
zg@tY>rsov|0x-*oPnk|0;1@<sE9(JX2@0t(j_Tx4hSh?HalQ3z4T}jB6}g5qaszj|
zxst34;y6F0nGT^MGN?`q5k6%<$He|D^4}q+ei}7*&7Zo@Lguhe)*csQweqEt_kB$T
zBVlc$j7=Nu-*<XdJDNnrL&;yF;GBR_@q>~S5DqA)$G+xYV!5-YN3_MPG2>FHHAREF
z3FE%dYF%@Z|3cpCnUTnO0SH+!VB3k`z?MV6t{2N_0t8)*Xm$?L@H(J_SPrL(03?Td
zsci=)qOQA%W*eMjCjhMytnHYM*2I$II09u3(pi^x?N;~3lcdjTmB)a+8_Qy!3Kl$3
zG3gm;Z!=O?D#Xb>F9fSzvr!5jakHJO<5l}ma1U{cy3Z*CrJa$;Rlo{#tWZy?3?&eE
zzUQcT*;Od909_avZTzB13&vA~Su0}Cq`dtiu2SGG%Kx1xP;cfh>ke6S^r3~YtYrYJ
zBMccKa0YCLTmP_aNKA}@8re-ACQR$Nxr(BU?8r^UeOG<IisfrC-_0d&*H%3?lH5MH
zNg;J_IPqScT{2rI(Uvo3!YcBci}>ZdoPgRk0#bQRIE6L=7MHtR<JS{aK{%<coIIx%
z_6`rl_((#ITL(3f|GeZuQ%&~~yb}pZb_Mz>ht{X{{8t&dGCG(lO022UdPlnthd2o7
z$ZAM;2l9k{frq{#2Tc80ypUkv`MtK}9STm;n6j0O_-utyknELUYnAn*pK5%@-0m}6
zGU^uVr=_01Ljsf|7<Ekt;_R2_3p2{k6JFPVk)BIdMUS;%Q4Tzz1u*>NAG`>qgiK8i
z=(8t5na}M08T-}3mz(en0+5_G`FfrmPVSW0pgk$Vstm227q5vHWF}!ff>z(xikPXu
zyggGRKnu7@l2zzI>x=KKec#Kr5gi{GZhi>-+PPtROj#g)lyr|9MClW5zt!Pj^^|VE
z>&tGnQ4HC^;X%vSAw!)z7Tp}qjSWwr&EKM=;XkkhhpRLf6UEl|mdpvz(@ma!p@=Vf
zCMr!xLwil|Y5jm`N$#KCLINZ&JF6GT_y{Dkbn<oOg8|uyCQxHzQ}XV$P7=i}*AURG
z=5^{65<BTw8V&$-U))2R8XTDUMp%pi)J&{#ubMKl+|9lTIwkVSg$BU>DWSX{!hv)>
z+qX^YoQnpyLf^st9-JkCaLs!kFFE8uoC3<S@Qf}@r*4RO+8R@tlcuP&xhF+2UIkiq
zKtE!-rCgswHAM4!TnWanKBf0@bxdC8L|!&9&wgUY4D;yvti;+|QUxjZ78VY2_(7@6
zm-cpSD2rs~Rn22TRzM1YEa-`q1>Q!#Ag460I;Kn$g!yMt-ZXEL^r)irbMQV^{(_iu
zK}p4;zQ7RDkxhf*XkRzpruk?a-_@cwAGl%Iy4I|XoBWM=r;oMQ>%nZj=UWT!o>*L?
z;Tuln7kN_VkdJ+~7|v`$IY67-S18nq5D5Lwi5R4#a}T=Tvp59Ff?N>1&w{qkG5wq^
z0k(ZqxwY_=i@ebAB^Qo46u_^W=aziI$i@W!Y}Qpb6;)qjkuq^BZ>qObw~6prAmrss
zXx&`n(HW9F=a%6QUjOquaohK6ewdO7>A~K*-nZrq@CcusQC2jPQ{tm2Fs(iSRCW0{
zwJHW?a832`HW;?#aZV;a*b<@R-`*9(@6nG)sN*#ov<o53*l5c|)zBnO7`<+ny0j)9
z_r;ePK&5)!xzGtqvSjH#`6rD67EYFvo@jbc!OfKE6W_J-aEEnO(psMM$|eoV$Z%SA
zf#?|Kb{Hi>dbp_lj0jF|C@^amg(-WEl$>*@AtB{w-c?ktf@zS(g_!-rD1E+z?QQUr
zGWe*SH$&xBpz&2C4??@O(XeR-nF<^!-;rAgNc5*s!u{wS2g;c`YO2KW27tFNDiick
zDYE<NTUZ9O2Aw`)BJ0V6mgV}RBPawDAgqpD9R}}Ni|f5WgyF8}#Kop8hyG%9Jz`F+
zQiRlZHkZ~1W#4t?(qZeRjM{UC@v}vjHba&3$U00~I?4MaPe9&{$f%I@_6>MZL6EBs
z)GXtHvXf4y77c7JhKD{t=?91~T6Ujl@anbf3jKHngDC*_3u&?X>M}FPHg6H&de`b}
z#MVUkprSI*tT^%r{v$~|3nY6mR$`g-5gGy;Ibb|to%6l@-7`R~R&VgG9D*x!fdp5&
zQRT~(dN3F*w!Sz&>z$RqqBoM&89S#x0~`4*5KP}daRs?BP3KrX?knc_@D{K_!V=xf
ze*!$txQsThzfK@~C&%FOkt;`JnZbTFOqalW`*axsx;9keEW@ADA0*oEn&Rm719+D#
z2!&*VqY+INPryIsRC)DFcDGd=S)}dbCQLz0Gj?2sYv4UJr;xLXRGGc~nA8xXu_tmP
zqUi0|BY?H2=L;fZfC3*iqDD!+Hlg>Q!;Xp$$Ou#M_ta~PEknA<5)K--9P+_8+^gxN
zBcuFqI*)OhW-6b>4^}t~_x{#7pU@mXFe#N&3na(wg^iOGue@7PsH}!8ea`vGxEAOO
z*kP7FcY(B`(}vi<xe=@%{gL&Exk^Stt-GWV(9~SmWuJuD1Fw41QO27+K%V2p`(>Xb
zRT6AbBJqiRprdiQRJAga=fN?;4uW(>$dLsCGqGXhTk6UC%Imw@&|2>TzHG5me+7MR
zduv0-kEKin4eOm7ED5YU9${o4xE0CtREIL`bBa9pcCB8CUcJ@y0^s=?I2VqXPY#hv
z@!8s!m)%J3$Mp_Rs63Sn?rVF0+qPuRi}8@w(V$`?p?H^0oI3Y3{)L(fpre@%>Fc&?
za_*u+*e#B1!rcFnFvO2I{eb$5xhE*)*>Jl7o4Ry+D5@<Mb+Bgh$)8QmcyjvDF2218
znuE~>c?dv@wGJ$MueI<Kzy4P|w>0OwIpYnokXwdBOEX-6TdwS&pj0?|%cr#R6TL%5
zGKf1p4aO>C(is)Ft($^{S3!EEs`bsH4qQ4D1W8lQ(>Be3-a>nuH!D7(<-5DLdj#4W
zV$4=`-M(Hdha#UT_#A&Ay+~?|qR({>LNZ$3p$E^Fs9gCxmDYmOTgGy6Eb2lOQbA&w
ziAf}@6z2ooP-SfkTg$+SlkYrv6kp+JFdwfK*XokhMn6b7{1IBjHge(+7I|ZpqfDK<
zoSc|_BG>Bucb{ApiVW#;Y!0vokt)SD*6EM61#qU_5|FF$sHp|W8N9G?tQe#X7hCM(
zLKS!N1#0dAR++|!<=9w$Qf)BDdSx|v<XNTXEXSCjFb<2k$1}`rd;^j2Z>UN$=7AAT
zzE0M)K*#)jC@o-I3ox|V&~wRjQ9V(B4OI!{b<-@<8g7!Vd}Dik;CbIXS2o@zF(7A0
zYPcW=2>z-$C`C>U4G{}7%&s1O_T>1y!iz=-1w09L$SZowYS@3fKS1_>6!g#b*CulQ
zM?nM>Y5vC_`fn@c@|D9}-dP2%>rjFjr6;)3!oGITv@Mh=T5-M!+O$kb-bBIbB|WZ`
zX7!uf?)y1D|1kenH2r1&)xT`UKl-ouZ`tXn#UobJI`PoqzkiCW<4&$a0b|H{<D7*1
z=WW18j*x|{a3e)#TJfhBnOFHRj6D8<{HdP%7yGaNWi$N?{Ac&yvWsM~)nj}2;$X2+
z2M4e3y>xdl@ZENu#ZT{R!YIBaKC```;P$tNQ>#*sXTi)F;{NjfY=77NSO2n^|LDKs
zzh#HUF@H%8kkwlL^xMYQT(A0#*(A_ddLn~n&;;X(y4|5odlUb`6x>%SqB3aIeO&wp
z^7lLc%l@l>*(`tbU-93vqs^Ofx4pm{<yZOj*9LD9=rbe6=CYSAQ{6F`fqp#`HHq5<
zFdksXWFedOpXW~G{ewaHNB>j)qv8$VKimIQ-cfw~`$S5Z|7!w$PXGXY*Z+16@taEq
zahe8A3{xxy^W^dBObH56S|bCQH4G`PdA~UmhDQ9d5&^1ww-vuQhX|5d|NdQ)1V33<
zlO!Ce+hGL))dl!mwfeJ-asF8F=wx)Cugf=8zpZ`&G5ZZ|tPtgFwEGSOAJH%{920Ww
z3Xt8?EBWQB!FeM=jt~qvuiwJ4+M#BL`jnDiYbLx^;)(2LRhs|=l#G|4dJ}|cK*824
zu~?UJj?T>?wUqe20r=mhCpw)(*eQ}eTB!i}|F{lAH<(~g4-3>DJhiql4P2-|(6T}(
z#PS$y&G)Q>^gE!bbZQ_SaPV&9EN1~c*{2HiFI|<%WBa`~HUPesX{(6eB0<;ASLDo>
z6}$i}=9`rC9y~FzgI@5-|ABtKBG4%;eE*xE?zuMzAwP(d|LmwFcC+JJLVJ|(>}n7@
zW<Gpq!MX_vPR19OW#Az#M;iHP(Oyp?iB|Rfk=|pQY$t;krI_hm-1a%DT&W;&G3$N?
z^w$JIJReMJbL49+lUf8Ku@(Jy`nI(Gr%5Pv{0L<&6Mn18EET~sMU8W=Ga4sXS(#~L
zX^TywxK@0Wl~Mt*@kf+(4I6~nO9~}f3=X>}j?f4gn%Y{n{;=<f+X|B}IpCr&er%B|
zXw7U6XPId}b8$dmTwY``i<S<9h>{=*y|j+Zq#9lVG9i+Uw(BmlQ_n}7nmo9&&s5sA
zZ0E;42YtbNBl`Zb4>}%_xfX4!1YK}nG<0B9mTyL0x(1Zl^HP2Ury8ENSEqoV^d2~g
z8)Yh7{-Vj?m;u%3c<o!}?1yX1x%K4!tSNlfy4#gn2uuZGbt!xH{Bz%DC|wT6pw6pk
z_3U%4M@zobz@QQUhzC2QhJU}fN7*zex3uho4!bTFkgTc=c#0T*8lEU;gE22=;JfnS
zcuvQ$Gy;~T_ygBX)XdvZ8`xAy+-GjC`k6*97!&s@qv3la&;~A^Yhf8~voHl7_44RN
zmaV&l`Tj}%{*T&kICsN>n3St)8rJmp0Iw%D_`r19b>CjecQxgZx>|d*FT<g-t8<(}
zr54V1hxt_tnHn4=H%N`005?nOWBc9Cy-WMRHo&-RWMRGj_8tOfqn1I=J%9|aq<3ez
zB}n!$OnkTuKCVp^V1?rIMZfegBQ7J_FM-ke0@S;q#NK373%WK&|Ie573JIC1q!}#b
zgtWrfn)sNb)9Uu4@z6%@Lr(kEcv5p6|70P>bW&l@ySqrK9IZ%@RAQ2Yx+)iw#=3*7
zpC70~au{%Xu%Krsz&Qa7waZPf(B-)2We$kp3zg#|E4v@gh(zLhu%;@lO>6#mdud9p
zdPpMT=+mp8fHcr1x2A`UdZ7-x)kV#O>TY5^r8|rA7{%?6{xH_`$S`?q{%*-o_EH%A
zntXDFSMb?f*<XvfX*W4iskbHY7S2+53yd%TL>QS;(=lQ9D8U`#f@kv=?opM^P$xSb
zCW3iQx0<sW1=1OK?GQ2Zf&d&52Vm#FpGgiUR$2;CuPwuTA{dA>5o>|SWMKIQMxAkU
zaq1MTh^^oTnphO7bc5d=Y~-p~c2wwiDM(8)2)#4k^q&226Frty_l6ebH;CSqT6M|G
z7X!J~gO%j`5o66tpPPv4kpuj28mfg1Y%V`nj?skAFPet79l8*OG~ng)yj-e9unGNM
z13XPH<8KzAVbVQ;UA_!nZXnBaPxS8mYYMYU&<e^!f6O0G>n@=qjwazpF96$<Hi{HL
zp%Hh}rdeMWP5JZ{I{0aiA9rv**)jW2w_+OU)n=Y2Ml_@JARh@a-Gdo&6cxgLFwN+l
zU2s5Zv1z_j<qVeK1~H58#SXA&2&p`-|L|-Ogzq#d?Z}^tCL~IFDq-hlmKi#@>8?a~
zaK1R1ZUxajbUQ8X95=x)N@51S2l9p$a{@s>MPp|2$`Yw&2^D6{{IFrF5?*z)j|;wU
zP7j<iS)dhUpgk}D1<q|OOnu@Y(&VOWohe&M;(2v`R~Ee_0YuwgOT=L$t#2O;pW>wv
z^xJ|J1vG!HIQFb+6a^F`W>P%x)I^h<Gg#%Ew@e6D6g!(V!GBY(1PmzLF#`5Aq@b#V
zc8}lW)fchMe~d!t1j%;Otl8^lbqSv-bHwituSxcJ-bw%wL)u&{gH2!=t7Nvr22&d~
zB>)cvU^NL7gk3j1jMjPQwA)<`k4958xgjGbIM8<-&7DzBZJ<wz@0zVwIHcHXG!$*Q
z%soQ}5+OyuI1Z+v_)}93zSPm#(ZinOq5Cd@vT=Zkh9wrdbgOBx5rzdkY>xRj3*3P=
z@nJ-mhilKnZ+RIPm4e}>Lte9*n^db&RR#>1wZ6G1ag8?NcO50Unv~PIH!8kPf;(6F
z=8VW?B>tCMnZTE<`F443?<4h8jrCSg_{Pw5M{7I%0t+A62{rQ<RkMdQ5uv=15rN;j
z(pHpe_jx}*xqN@XPZ8)iwFTSRd@STrc{{SpUD*x?dU4AOM&8gBN)Er&lGdX#!L<xd
zGd8O|C|{sM5NB!aiQ6i#0=&tqT2fwQ>UC-ycd1;@c#S@43Wz_5yaW5Z^@`v3o>qG_
z7l_hC3h8T#10YFvH-_IlsVYOT^^!$i1N9sbnHqQ{<_S$*vM#o92aYs3_tp<-y+wZ6
zWzO>DDqR7HcReG3oq{R0>9M3ntiKp<YCf33pf6M@yvZ;5iX2)fB1IGoKEJ)@nw@<P
zh2ZgYUcaftNn8Y7N)ZoXfioWKAqxhFs~Btp+cYWp4xPfBtY(}=(`akV@@dO1puL#(
z^)sWzosP#BDgTfSJ8A*p#H73=-~;WrjKG{z7-2+<!*9XG(bL;i+RPIa{I1JwlZrOn
z5%HU^Q8k+9<zjyD%|ODS?tq&bph5S;K4k!W0cZ^w1&gh=N`P|W>rxKVc;}=~=02-C
zP@t_Iu~#NaEqS6B#8_Hd03jRxsrN{Ph!nn;QWqNDG)3cde8>Mp_||l(g2yqSDdPI#
zbMA0DwlE`hAPc>#B=1G&@Q#5SZQkA$`37BGJbrh@Juey5l=S=Z_gizk4gYal&k%z&
zxk)5%B9usN{)O|#!;o-?{%l4nM)EPYwdp>J)&x0=#Ty5eC9Y)jT#dA|Qij?Tvz_=3
zSU$KV*2VE%{^db8bw&^wZ43$@#Q~y6+_`i&8R@<=0DB2ZS<ZmXQa=r-H}BLH#_do5
zo`aIVY-o&VghsM_h}j57^?-cPQ>ophyiCwYGpFxHB<c%)A`JXaAo|jxnL0glPbYZ`
zt-&WUR%pXxP={(No#75hIkR4)W{OZwiW^{(e<;rtd8(*T^wOXU_T%ejpv_7jzO(dU
z5nXM$jdEpf8H%={{|Y^UpMxR$HtpgVnj2#Go@D$pvWhf3aWQRrObik?;F*TfvvN%A
zoPTG2n%FxFE>n*y+OXo44gNR=2n++}g_>nZiI5_7#G)e)to;)CXH_7(d0zZ?qbLDe
zL`36`Fw1=FCZxbJw%X9#v$e$a0xX3xZ6Gpi)V*7%uZ9JQ8NQS?8E`;l)n+^GqcqQ0
zoGT^`PQ6a<24%Cz#}#0BIK+B0(gxS(6Yw?!N=_}~ctHGdLT3^NL2_R~7A>G3^Fd6>
zuO{SVJ`xL`v$_|C2>itbovRdsB4<_d`|WB08wY`!b<Nf*NgJ)^Z&+3eDFDRHOR*AT
zwWgSSpU1gNF$db8&2!jZPHD(7w-v>+VfO5rdGOKo*y5Qlu%w>WgFO9d06X$E3=A>q
zOs}Y<Kc!?g*I4GwMggixXfqsPw}Sl2)hmi&!1~!qBTXW!zeW7;48HZ|HVy@t9Hl;n
z0rbJPMX{CAGN>YxHO+n)BdlCSMotBDSvllmmqG0YLu=lI2A(9i5q|;5Q=d(GV1pO`
zS|*(5flqBxUVU;5jkM|Fi{vSBR7}<rF-Qva7zuWjtEb<GaX#+|?L%k6F^Rs%uuWQp
zj>$i>8zZKc-^827)kkluCy|HX$n5SY?`vP{p%rNP{`n(aMZ&tHVVkYn$^p8c$+$xX
zuloio6oSCF!C9oVb7BHxgHD@>2V}4>28UYd`Sdrvlduigz@YY|%O>M=S!08ehjzx<
z;!dd`Qqe{MNr(4$v`~`E57gf+ix!-QA{m(2P`?c!QWQkd=u>I|uWI{HJNCR;V<(6<
z!{|Qq_X2WZZ(>IfJIj8u3p;vMxJN^|@COov>VY2KWgNi;E&SlMQ^KKrsUD|oUV0RZ
z3&v~4Cgu<Lrt#}AmUlE$Zz3VdKixS$d<ZY~8Aepm#euX_m>Itat{zshq5jfH4XQs!
z9TnLkuy%4stpYfto{qOEDdkcTj3_m*tSz%1M|ec-7x!;N6MYu-Yx#*&Sg64*&)xgg
zd-)D~*IT;hGMF2$ea|h&A<g^Pg{Y6qkaqxX6J-ad)@K4T1C((PpdFgLs|0Udf%PN?
zF-&<~u}g5OsDESg@TgrCNt5G#nrR@(Lj#7iPS1=W=6yXJv`N(#q=w#CQGJ%i7iqQE
zR?daRFy-iyhXh=hsiiQ-5EA*QZNY7@?@x2#Vi*4Bfk3tm<iP^SVP#*p*(nhh44b6<
zo&aFz$$J$yZ$GKW*;v$-?t<4(aI-{kd(|`>JQJvQHRuUMf)L!_s?A-kW?ll@6gq;Z
z*tlwQ5E|rZuDBJ`;IvUggoP1QvQFF+(aJ78)cRXzhW6D(#0g#}R<v;QN;DQ-y)<z`
z5&<!8WQvXvT^lEE>W*{i#Ela$k7gfZW0OHwrq1!iTWTV_Anypu;mM2|<(hw76KacE
zG#fTl>A3$8%bJT!51G)YYV`vV2sL9+@Yq*~r&I+6-p;VHtnqnh>e9=m80LBgfUkN#
zJLt)U#4%I9AbFrae-b|_v_zy(92KykD>W;us}0|5mUGe{xc3~hBgeHW_;$V>tOOke
zS#R<q3~;3|jRY355}#}a?58Os2MLD;sy}8Ku%Mr4LqZfBp&LHkwo&*~jkxBS)8n=w
z9W3sCYk~j_2SG2NF2{o<bvX<!K1@__KC_YwgT8nYEpzXWv*0-qENI_!>0(d);9@YI
zNd08Pqh5oAKx@u|@Ni%o>4}WsuOelc@MelorWZ>I=TZt;2jr5gZRl2U$b-;_45_N$
z9hy**f`%p@rTobyUV3!s>QhAU60HY6y@0t(Q7q2J6R*R}L0ELU^Y)h(YBlgX+Ks-u
zmU?f~Qu;vA-kXk$t^pWkfQ+o4oh`J75nhwJZ;gy7ps}2dzt4-#t2XV0?Z|wix~Jz!
z=ACC{`*p9yG!U-}wa5edYViil0hwK}%5sSvu(|gF6(!!!L+D8g-d@7O;Z3$HUMZE|
zj}VlTXZRWb>Cl3TJ^E8h_PA@DdM1ih7BMSwiY+$aQiAA{(#ytGE8p@;dK;ow0g4uw
zCn)?PBLEFf(D)I^DEW7Yy(a2@cN^#SH+Zx-M*<fetw)O)12o$W(^Fu4>W^}{&T}O(
zi-zcNn82uST3yNEL@z*)?=btVid#F1*QAY?x2YeQ)I_~ecA>%XJzU!Px1M5GS@O)W
z_EEA0-`m3@Dc~1<28VUvoKFVn#<jIad8L@ZI78n`1xR`6vf|E|snuu8{2CmHIU2)T
zpV_xcX!d5+$Gjra8H%qfiB?BRDVKIkeXd>B-a_~eqdlxxn%frVj9AyreDd>=6kj+I
ze7r`ilwki^EFNnt-X46V9CeY3=Jb^w4u6T5+?T8S-JAuyA*<8-`?T1(>a2t=R`RG#
zu4F)JW{{!bDCNFodnWqn78IYePOMA*Pf_+)3023y1IM+S?Mp_q@MWOfwt546il$jT
zJ&_Y}MzPSzF&Pgdooa|YQoBcU@E9}8#{d|wV%L>k?#;Tj5f(O05-_6ujaxCoqt@A+
zO1n$TZ>^mfZtm*NqHe3^asKB4n#c><5PCd9gYYN)RUnzW6F$R(B%Y~|_!n}WzT!(I
zeSLE7rOGgKzT5-b`44<s6g>Tq-}zRt+UrLB4j_%%jR?AWfI$Gq^*N$#=aFqFZ(`pH
zwCEuB<=oqhujoQ_9d7^`+*Vvmpd`Q%A~KK_7h0NZKYIgzY@jPffV4>#ft?CbM7Rv6
z&8;F>VDYag{>a&}*tcwZ&a_~_YS$|uh^#*RQrk}=v_abTbts}}nBxd#p3&eM`3l$s
z)ILZT6-VWbr#Q&!?O&Pit4G>C3O)yUySVl)b8$w`^DI`3nEBP*K}u#)I+-F4Qn_W>
zvFZS~*f@pj%7le+PJ^fG2Elb?Q2%ol)y%v`*D7N)KypTmb~?5SV0*&WE&7H$kYTvs
zZnqHhx52J?z+8{?=HN`Fo1cYrY2A|eyH540Js*bNQfhh)&7s$whXR<hE-Guy+Fb^n
z!vV}BbhhN9EOp6SE{iYUM%46JYh{{=8s==y1NLqnr|-AcmIiVTj5`Cw)>YHbd^-60
zIGd3U#kcQC?GzAw)^a|iuBPZ@C(80CwdeACwieNB=*AK(_TQ$`j-|~~wV&Ca<@GZ_
zyp}-O=&h^rI?&k!bTLukv7tcm7<m3yEY2$FA217Y(HDgMP5vznT0bt8XHk_o0h5;|
z)dTbSVHe@RcRUM*%bvHRo{81<)b|+pH*IkI<i%GYKaYa%r6Cr;#13|`3)jsORmtCV
zt=20Af%c=<dUSlPRsfFGb-OYpJItGqg_r5SHO)=%fJDO+w^pn0_u^^iDRqgJ<?b;c
z{XNTfX_sGGhTa?b-%e(Eu;yS4IQmpTpV`C|HaI1%&3>+DKy}~fb?^K3EG-$DJ~mbY
zT}DvIVjxzE(Vr1*N@0+M;%u(Dh^1n0gCUbArIDDGSWbbYu`~FL*0f9N#XCp#jeasu
z@ic7)!px~;4N2#6)znE(LAE<5s$$_JyB1b>+$1S6PbsY%tzCr#-V|kQAVU$%>Dc{R
za*ZUl&l7m?8r$Hvp3aSZqdfoNS5w_$srwv4P^9CxmkC07269*0YT-9`m#DZY+5dA1
zV!;!@5^9pU+x5eCYWf<)bpk9nBJr`#aB>WdgzoKS88*BKPJ=I;nBeiD;|BUXN`;$R
ztQ3}th&df|*_(samg=l<$0eXKz((0x4vRK;Qn#;Q=`-vIL4$mUgc**Z;F>%;BMw~Y
zh+WY8AVLnaE}S&$qa16)b3DVxhG-_2Wws^w)E$Px(91*3>A>nSj+k-JQ$9auls*mw
z49V|2VVUi{UUK6^Ak!nOt1O%zXc#&6(?Tp?4IrQy=4dM!zU4(TbfEa6xn+b{Xf56$
zm+fipA!?Lm_>R)&;0BL>i$9}k1L002P<#}yY0Ef-c%Q1NK)*41eY(v!5VysR!>GPw
zjAviX#%`aKKfb^}V-~N5V=d)IUqA1wgK&9YjmF?arc}0|qy9#6je5p*c4MU1q23j&
zusDRFJWG0`8zMadus`e@Oiw1CTiT+TS8JW>q=CXEn4dA7x%Gjp4=?2Rfsttudh!ya
zHqCmsaz0h7*Y`^nAjIlQH%-snT4F|B)&>|1?daGdzM{)p3;=Ufh1R-77~n*3n8cTj
zmBw;PcI7aj%-cbla6oMur5{#+t5Bov()B}g)gUll8*xUqO00OZJe}HF2{A6BeYJIM
z&DZ@bxbm?Tb)hnK*T(IOp`<brj%iXE5xk9XxG!{}*T<1qY&9D9=q9>|>EUJ=2cbk+
z`0`TYqCt5Foo<al>o)&$tTP%;8|~u9D9#xkyHE8MWlVWhjr^xoOPN$e@P0Kyjxz)2
z2n-Mb62_e>m;g3cJ9?@eoaD+DpUFelSeJvyVuWHh+^W{gx9wYCoC02>q2pU~XD!Oc
zM`^agu&e^Z>-WxASlcUN+ItrdQ<_5SX!7m`nb84xB;`>4!{lxFjt))9FT8V$`dFoy
zhcC3`?Pa6pgcF{_SiH;LptsxhqI?veV<&`_JjTqzlJtgw3Dn(1K5N5Qic6DZQT0>w
z&H~&S-k;>adwcf*o-;uu-qB6Zo|Ow(Win<>O%hAKy)_uUyYOvUAQMDiO!M-O)WX$L
zVVO*111Rn609;_<bhj5C`+Ij5&b+wgSIhe*j?rBSv*A?!cJ&@}Ry4?LhGTF=928%v
zXex9~-sr_>hO1vh^np1*m=ji^vWKBqu$&)-EZLFt$&hY@bz2NB5rzRp-XP3W>6#XG
z6JgjWoCXnr<>k4z7VzgWA}_9wzG{+n4FJ4qZT5Sl!bH4Uq18sK)}S!$Q1-A-#9;1%
z`>wi|A@l7S)||#cyF}duvj!V^pE69@$e#RPX>YYoNQD?pKx3^CW!US54NVv1cf09E
z+$289#y(XA7cy9TutP+tm^_dgpnP4G{-mA|3*~OelHJN>ZtV<bNP{j}{c6Xe=T=dk
z>NiXISd;`~-Gyf>?pyu)-c2Wl>|!5R5KmDg25WA|OJp(xR{EZ-OD^@lZ>xlTdOC-i
z*4@~_z<^q`2;R$3lL@(HvNq?&b};2Ev^*6!^WlmVxXYgc5c|KvbhFg;Ol!ev-l3ts
z-TGKPjmbPBixq#QMIG?jSOTS{xZ%Dr8A;PC!r@#djqaD91hUK6CBUwx&LM}c>cqy?
z$Q(cBKdMvaTW%0_MMFaY;&#pka>3IDrn#<z1QS_#)l<}>$bmxCkm&Rj_B5QmF6tKK
zS>gyvyHJvJ_|0_3CY9vD?1Fvv229i`(?Q6`rp@)(vGq?>Y@(mT&^!v%guY6wdE91j
zQTYr9e7Q|^dxrfo=AU;0sl(;${bP$v$Cu(I{-ENB<BYXH)58g*Z_uxY#!c%~N~FiS
zh*DFEUPg_4RI_)!PWHx?w}M^K?Z-(?Nx=6i2B&g12}_}fsjJa;girM8i}xHNOb6Tr
za|dqQR+j-?kOFE(4xjGeeX{e`zm}t}c6~=el^^7(=5~66+E$N*Pw|G1?coGH5h>Rm
zo8%yYPWgn|=fCfN@KR1<704Z}EhDG=Qj^M1pRF*tZd(Xx8!~w<<bF*nqhG>Y7;lDs
zS6E`eSagY(xsQj~9g%g4Lw{9MQvQ`09Q=O(JwU?0N7o)KwcA~yO+qKm=y95xHyq4R
z_F9l9!$2gUWcJ-FT<q!FC9AoR{9+CODNX1PqMlB&adz$R#464%Q^6<J+x9aghPnBO
z90CQk97VuK&sauJoP47C+7AfxAi56Iefbi4j#iq#`f|=8-e;q&AK<Xlw(M0voETT;
zlPutx7Q7<2hH|u+7sL$ffoG$r7};aA&04N;senxq3pXjBp^9klv`-8D`g2vm0xXb(
z7v=-40tJsi%E!VOx9KuAT+8#402`FVyl%e`wBm#1{V<~*43vm`O9m}bHVi)!sGSG&
z^^u~u9on^=dpqWL9&_2y>!TGBoY=^Z-ic+jt=_W-DcCmFplSTPjKVx+Avu^my6&+7
z?@b@;?&R<5x<GXg4e0uDMgO;ew<ma)iCOM0)zBfOk-9#f=%bus=zB%`@<^(a#c04m
zF8B*s;ws8ySO{Rp<=%WR?0Th%k!lw<EW(2ET%i4ybiB?vKVd>YoT`Y=L?PbYO-q$^
zvZ#%%65AijHLX`3g4%jEEC0mRogcwmZ`KB~ED&jq?Y}y;IAEn?{#7`oXML=ObMUQ;
zb?T;tCeXAFj|_g+Z%mZwlC~_hzA6~@<<+0>Qu<1`(;AS!{MPF>Pdg|@?DH0B?1Sw^
zR0!c<4LRTx7Uvha6Z**N{N>zDH`b7uS?;KLk#V&MOsrT@b-3iH=O&rN9@*|kF!vFT
zPI?-@m@e=+nw*Ou`JuP3n3vQXJZW1ydQYI8;f~;XWs-9m>(z;E(6~;=gMGne7un5}
zAp`9k1K@sH<h^LS76$6xvZ|7_t#77*nq29gQ=qAjD;oVv8t{afFcd7}rypQ8mC{eR
zNY?wa^v-2I^;Fg6RGr0g*d~^PPWQ$rpqFYzOne-$UWCr&PJ7T|7JHYFA@JS=biS*j
zSah27dcdx!G@q8b<OGGI9=HX^2DIyYx1s9S_|HmuIknDM;g5oWJl+4dO3D9n&Lx_)
z6axTMe=@KcX|}iOc-IKFn(f*gq^OxaJid}f9tAo06&jwY;-gcA=;IwkE`MbXDo$TY
zyd+OTxw5WhNby4Gt<>Hf4B2l={XI^V%g7x}7^T;jIj5@!$HpB;^4P3zFR)o{_tdp&
zYN3Yx&b4gP%3GLHf=9DI7Upl@ccvl)*^LZt!S~do<0dxjgiH?4I!m~05xNw~HpZv9
zKbvxKqBlKNL>f%YG?zUz{+vILhs5-okR^cK;@0M&2q|T!#sGPvAm)CPV-v8MI#dOc
z-GCTh8Z&7b075rFI3K7}g%n6ZjMQJhP-tA;_W(T*0#Cn^LAwe%X1a!lC{=BD-oA#I
zUEB$L^N)5fA(lMeeT<jeKoZn<madOK(tlF*Jdi>_p-BLq6WySbAiWzAB~`H>-AAG3
z)C8mp&s5Z`kDLpv6~<D(ObA!JE%{GSMSb^z-05eZTqLA|?3xAJTb{mwMGoeS))1xa
z!puivnC0-nyy5$d3GvG(_(QLV&`NMrBHM+6*;0(W<-AYmcnYg|-q7ig+VNaKCrTb0
ziV&Xw!6(`Z8eAL4rt$m@Ym7<~FscN19h0%`HGddm!fo6h6kro$9|j(D!MQP`AkiDm
z5AXC;jOl#IAh~ZTuc@&tG{HSh6ef%73%>xvDe)m^@tF_Z9vjirga|Rl%JZmlRE1H>
z5t^jE%sR*53+5r}^gFv9eAkxP@T{-aQkNeuL9Kmbo~JJxC;D``yiN7|TI=sCAMxhF
z_T-x6f-Ali7!gp@;?;!FpNkMz&K^8&=C3}_!{G)U-`UcYcp$&weLePHO@O2(_=(eG
zL+h+oj`LFOHI%VJ$<y~u!&5+s&0k>(&=&R+sU`UCDfd!hvzgP9K>?`*)|Lo@x%Bz~
zJUPuV6WE1miQm2JMaFp);5(c6D&BDa9pWTF9e(7%G-IKDi~L1t-hul)l1+ylK@s2`
zzxsm|D(jm=?h;*?%22T7X6FhTSP_MN@Pnes?$^-#%wUQ{#?G+8tvq1PL|%hLH=d(a
z&Q)FISFs^58-Yc2SLE3S5C`fsMfhI^^I?zUk}~LL8j$4R4Hes<mU8R**rd6&>fKFm
z$l$apsYkrp2(-X-MUsF1FkYui@N9B>G1NVZ^a8tacHT9BzR}L>HcGIdVN>Ga*e<C_
z4v1PA`r%gkV0Ex9eYnyltABi4BIyBK)+s|FNCtCCAlKm3l1+oic$)+K2)GnsW*}0M
zsFSc60lucgH?E%1H1EMsz!PZ~gTP9x+1i$m^mldFr9g*Dry9oTbogh@_-Qzi7mDND
ztTT73E#etOt1xJ*H|)8{yLRC~L9>1?1vyZB^8A^nnE%skdGZwf%t*nfzEk6AKq4y8
zR~h+kE+kQ7Qxwt+ch0%B!U&=8Dd)wvJQ}Y*qod^iv_dry35V-r=^~!u*=`5)&$~LI
z@}x%cftqOOpak_@3)I1vRG$5!)~>TPX;~i^Q=OJzNr6yUvutor#qsI4@oK3Y$#@}6
z*Z-KEJOqWE;>}bu%X-qfh7+ZUdz7NZ?I3SeR@%yw)m{8St&6n*eZ@Nl2^1c~>Urid
zXHI~Ur<6EmPeuc`G#`PwF#CbGYBlnH<#%O{DtF8gCGiBexZvd4KS@-BpEZw%E4UVI
zSKuqxDHNI3tVN^)=W@cfN6Njet9vgp>NO)^eR|39JwajbX&Zfj0kr5gqxRORaf}zc
zVUMmIkvOZRC1)dJZTN_6Nt@$<IZbZlLAOCizatSWim_FM=LOdN|J4EfbAuJ1)7G`O
zM`*RBum5OJE82c9k-z#0`4jjE>W60&jgZuLW-@nc&rhjzn6lyO|9f#c<&pblN~D%c
zaqdTQ&_Sc*wy2lA#%#dLkX&1iV#C#VXrR}H)RMs+_tPrTAamMUE|ZBs4~(x%6$#8=
z;*Lo`+0Yh5$Lw-P;A|<};8hbf9rLqyxCOs1&l}kaCSkn*6I;AaDbbPC13rbDj$4X*
z&P<r`SNVr|^V~~S&y*~=jYG8y_Aff4$gDl|8#=2m9hwNW(T0m82i+}vZjOTb)#*p#
zqG)&Q@u4iXn2s9OlG%(cRN>(+UMZ6`U8kQs{oG2+@Q#l6Dw9mEy0U<{Yv`YZa<u#1
zti`xSJcy(Fu3XISBz}cfz^lUhZa-MlQTn05tx~sorVZxGef5|gj@i^kOQ!I5O>)4i
zX1hDVLjxcaAG+u3WL4w(2QVk6rWzy#`A49Aq02{MbD#tXGcZZM&<)gS%zCMvQ18l)
z>|>>*gGF!wTMHnW(|rjO(pq=>Y}A8T7|g$;@a~Yx`>2$*Eu61v5$uDP4Fc*;D}W=<
z*&8_9WS3zJ4Z1V1bH=9OBpHm!9&IN}0^6JqL{|W}AZ2~KDUx|`QEa1H0OIK)Vs6|e
zeqf7Q!&ZR5&MUeUuTzsOP-36V@^b)EQVyr0eJ58ib!rf2|Bke}6E)^A4^KblMV|n3
zL`?VwRCV5fWo3~j2DJ>Q1fEcreSydr{b8k=N5thq3VPun@^2l*R+?}WZglGv%+@A$
zV$}8Q1U|X^6MJ43(s)5DbuXQkLZEA_r-_YpoO;wMC6Em??&iSz3os4GniOHBEY{3m
zXh({5a=W9|6Rh{lUZ!l?=4vmJB|K?LW@RKY<`%~q)J@nEE;Ui^+n*1m@%6AB2jPY>
zBO6JOwsXn5&jVvP^gS2_q%!|S)veIAW3OFA9>Ye2XD7VI_rcEbRY;SxF<qHUpWAGk
zdE=54e>qEin865yUy|bu;kL`@tIQig`JyF$O1tB|7AmZtkikseciWEs5D{CH{cA#<
zcEoP2F-+0L5qy7kol2m1gKRQa+{$-Ub<m}UD%jCxuuN&9<FAF<xtS@H(NqKsOcEU8
z*Yc`u{AAt%EsYg!LDMG~LRscHdC9Puj&*GZ@`~8OV5p5AOQ9t7M?~7%nxwToYI<-1
znXkTa+hzs?)KClxxBPNzyXgUcE7DGL@?HEGLi3o1H|U6DdR2eTd(GJHpFJQ~X34<3
zjorcq%Pq@OWpHKoN)8$W7V7=Dk*{y3fnAN&s>s^miA16*&!)s+q#*gSplZVeYya)@
zmkmw;UvGn7Fs<IR`A(5T$^V}@Sfj2sLJ!;~w84oB1!c7pF}eI}iggjkf4D@d2RwqZ
zpM0UO+Hz^>-P$}pxj>9GCGUu%LQ01268CQ0HuWV`gXf>96PyVPY1NR{chpV!#uU0p
zu+vEl{r!|bJ7OWk1njh>DdomN;v<94?_u!!5Yel<t9=D=B_t8kU`DjUH3HU>bo-e?
zkVGyNZ?YrR8WpWVHA@AV9`R`JJkNcmx<}@yMBWGQk`&E3v<tDiD9uBg6IGxcDA>dT
zUdG+hrOcvr8wW9?&wnq(#$fBXdjnOdsxg7YOde|a3TAC?7XWE2q6HPewEF$beB%!h
zfZ&shpXhd%r@jaWG2ylgOr8}Rq9Glmp@u<feXw1vOC67b0yot$%ukyjWym+AAjgef
z7o6Up7!&x){SJ`nr3{+LtesWR3V!6ZxJ40(`LNsJGK&nj7-*<KUFlj_2hp?f0pk-f
zonk?&9YI$8SDw7+?xQTI*Jf5|(T3%%Gq_6Dibxq%I^dCMqIO;Vm)($p_2IisvDRSN
zY<sJoJ42+lCBPS{*#C8*m3q=?(%tk9f-@<VMlt8s(FrDggcOjErLweK)E!0SOm46$
zVtP)2;A9^i={lDPuLo)hv7#%B&KS%7ER4a(6@m~Orq6|v7`+Mw<S!q^@uHdXn?;db
zkqq_}#IfZ3zE-~0-e+DF-CKk|PM*(jiR47^3R9tgD9H_{#GR*Rxj|zx7j}pPXhLxk
zKIrgd;@JZlLJaj#AM3`oV`Ry_hAtbs(3+Nmkp3jWk<wP?Lx7Y17|FWPX8QRTeyZv;
zHqoa94$i6F5e=$Zz&ID6F|bo|%<h$<2?i=w;yfdC{_2goc{~lMDPcc9-OxGc^k^I8
z6o5#S6Lfzs6~I~1aW3O<>LGwM4LoDud2Cv#3!)hAQ&sAR(%L0EwnOgs#4UxLCiGL2
z3b=XiLA$Yfx3d^5#G#_GA$|YChv4yvVxza5*mq^8JD!U!^xOv+Gebnk4K^1}7%W7_
zq84n|Iu8{U@I$g3p2{MLjC?0Jx5=hhv_4FS*JfL!%bqbKa1+RyA96P#;}pVqp!t^1
zk>-V}GVhK2vi11cp8vY69^Cc+_PyD+`<*+HK*WRSdd5F;s7V>}lUez@eTx*kL9tmg
zS0|SxCp1oeKzo4fDhNzVE5MA*?wbg7Djt=Gyl2i_&RHU=*>Z=Z#BW7U!%JIX1YClZ
zL9V<tF&s{jQ$$vbBF5yS{&&`Bkw(c)TyH`QT^x>BdJG=I-VD$*c6@h!d=8N8`@wyi
z3i4$Ad{RRZpjbJIMDeKrQIkDlDT<NEfiz2i<<&|(uri+Dbg}5*GCG0QZN5ZEVIi$!
zmBCve2}_&&GiAbb>J||H2F558%EdPFZGtRXA`caQQ<f<Yj6#E8K)1O0>hHw1<o(zE
zo`<Bo;?Yn0z@VK1k^g;GD_?Qo4vSZ^T{SyC{^0GWks5_fVlA`ITL;A$JY@i;7^3II
z@X4s*XFF`6Ak*3<cE^{k92AM5^7=ooY$M;8EohLQ>>Q&>(OR`wZ)koyJcZfrDFB^?
z1I(m2ICpo|y_2zPou9FE;1S09y?l^6ZTXHLMFl(PyNDLR>Uc~%8-U^2xF49io;yx@
z)z|F{giGv^xvPIkla98W|20C~f{&ST#C(*X_SpTGM}2b`lfOX;PkMGjkUbc0qIGGy
z&{Ueiu>RLdCg+Ubze22yJ|%_4`KT*=PWe`;C{D>uhM>!)zTlHX(hUC*{`Z%tR7>&Y
zokHuRm2pk6|G`g*aj$`iWp63ga#DMOh&u6Yod^rNNp40pq#!(uU#qX@p&~&xxo2;;
z^`HUUf$im}Eu*eJ+z03T|CkNd7qDT!Wky^J`qaALIYq_hIR8-4FW6}gMG%0nGj_nH
zNmO$(JL;C6)7F-y^7kq;BP~|D+288*-kXQ}Kl;LoImiTopq*tu8^Jg13pYsQD7?Mb
zv)`pS0F;bDpZLKu`ju}^`M>rD4v;lCyJVd-dW^9a=B*h>pWbva>ww=6dt6ct1{{=v
z)sQMKLAt8R1fs``v7Y?UPmBzAYkF1Ruh)DwO)8^Utm|v(^oMY?Fp~tmWDS8i+Dz@c
zHz5IY+2%D~^UWWYBZ=K$`^$3zM6xy?E^Iq7G{U7u*R(nMQLk0|av6&IiHI*{UAhh*
zn8eQ>35*66e7XDSUnOuc2^JnI9#KM9oS}F(rki5Sk6*<)IU1NKIJziNX#$VTO&hql
zs%{Y6B1(kcEdlEg<UJ_709_$0^cOl<h7{h##VjnG485)#y74qDEvnsCf8-tR)Eg9t
zmS>&ydqWs68fvDaF^`Vgry)g&K)n)Ihl%|T3RAWlshhej4v;#*i)@|9-0)*t<T#?y
z;`j4}>>0NUNYMMGJ+Uep|8zwp^G+{VkAQ^4wn0A+r&~TF84dnfuZTA}S*IOMLtEk6
z-FEql#Ia<+!^#TjAb;vCz1vFKW;B9LK^kdeo|Jey#7fC<sB>NAH+NLotlZ{XSZ|T<
zc@#)0PqsWAV&x2Qr<DzEg_W+1uVsvYEBLE<iKM>PzvL5hAw^QtxwxuI2Inub?bM9*
z@1D=ugET0UJ#GyK<iw!}famIujnB|&Lve}xE;efN`J4*8kx%E91x=B-FzKW<J>mT3
zeW;0Oiv^}&Hyf~x9t9fvdY9^Y>cV>si%;d1XW#S|4y%EY_Rta=QZ>f}G%EUnJs7bL
zYOZRr^7FK<oNPjeRgV_8-Fjd@3wouuOx?;{BZQ6cfg|xb_(O=O1Rp(?5&pq83H%%k
ze+PtF)>xy;-oF|+Rblw7m~eWZz|-;O>ja8!sbBWw>~Kh7zfl|8uKg{ghCD5)5!kjv
zhjKZvRia|jViB_pWpf5c>RI|B(?24dl>JdDS|<k<u`Gzr0b;!42%ZE2N4lzO<n8D@
z-a-<z_Av2rF7n|8wM8VRSTGy!<_Og?6#rY||Kepa9%@*xRYU`6mZGUwrY7nHrLxcn
z{QeRc(eQY5vG)HI$eskoDP9pJm*M4sQQd@fuNsO3a-tY>f(@q#@8d&fVUj<|Ku=eD
z?v)B<&HEPbXltq_^{bp3?lZEi!P|~nqU-R^9n~`FgRhQ3`=d-!MaCdo77(hcVcFXR
zPj)QeiY?zpx-2YZ?20~2!d@EGrBa4cz@}j25(tQz*Bu!nU(hTC!ovwz#$kacn9rTZ
zGGew9)L^>EIs`(mFz^FspN5WkAY|x=Ro;W$6$vTri2$C|MaD8Nh}cT*N7vpiqEIH2
z+GjTn@cCXvAAnn*tPs#9COHA&nWU3q@$05^Ey{^?+%ecgImyyn-&D<}YxCs-Ei7Ve
zsZPom8<gUVixh2XKv`*)pX`>jT$5CSIg|}2kl5tycSR&B$@M;<<3Gk+e&Ir(3@TGw
z`n{rXn6)lin(XiLyo7_0ax^Zb*It^y%Mah}Oy#Xh&@+6?X4)K30NpIh5u4Pz*R5FT
zr^&<(cefU{Vh5*pF_x5Oy#OseZaje)vF~cEkwuzvH9uChye;>tvrI*C5{5S(luI8V
zv<B~UTllY=t2z8`ob0{jDpoWC{1djaayF6u7!JQ$PjY2CaXiTvv8^!q9gd_?r$1bR
zcxaIc#{opL{X4=OHp=q+^{OD@zK}#KxFSt$WsUmtYHI1}D^?+FfKCHQ9z@T=IP0q(
zqOpY_R(g<;I~<_E;h~7lucf+VYa({9=ue9x*`c3#(b!(dgu4T6{_<1QwF0ttuU$w+
zkxuF0O?#1ZKgLmm6kX4c#99noNe^j3!VIbOrZiV;?;KZ6p1~|x9k!0=7vpVGwz=uC
z%%y%uALodfCRYseq%PSbu_HpqSfOm@i+X4xy<o(f9zVe0GB>fgFm?@fWU0=m-ap*6
ztpNggr>WPd@7fDin?Y04zdF&&geRRh+T9$byUS3dc{!GUJfj8W$z)w9(D@8+G8M0?
z?v~f!<8kpA6AsgKmEYW~(hBsA4?^{p6j;e)w*G>YCIp4vHJgU!LpmUTk9iu^JJ>j9
z|8~C3wL~rwC&ilUugQVwddW}22JU6Me|M#um1xCtn4<t}X6_iPS{6TrnT%t={7RP#
za0M{AkcQ*rt$Z`~welF83}&G@8w#*PC*NQEuK)UK5?Z5T7-+IM4znx60g(kl%dQ5D
zSc$aBzTT?uq@%OOURZYV=7Wg(`1!^%Qdl;Q$YGTaMw}k5@1}DOnmxtIu!3=w^;}Ws
zvX1hdCA?G~nD56^;Nh^60-e;!ULXGc!;yrA1|SmmV}pvs>yG3};ZMv9<s%_J@~%X2
z5uC7r-?bMm?l6-*kELS;iUVNlH}(ou#?1sAAvJn6{j3u`#Z*_p5rpGI$V%hg%SD+?
z>WW>zBIl#MG9w-xu<NjR=OW-5cw?<>rZrD<qA8T_+W9n>!5Qus>MV`|Rgz9nVVgb>
zBdVgKOzcX~Sa?NlCqEmjUYUc)HMn``mmoIF(!+^uqXAJmNg0{JC2@-f$aaaCzaFR%
z3)d}R@)Ux_v}yjxUgfNmVbo1Es+FGgohJiD>E)yq?|%qwF?#OSQ|J;sS@f$hMO77K
zR*$4`Ro`IrDhfeWbT(~mVZJ;{iy-v42y%Vy(nyQdh(;Qpb=FrYPqwg0QAB_J8C<EY
zW2NrkkwcypU-=_Og4-OP9t8Ixf^O#{yUXE<&kYQF8v}^=Bkr~*by%&at?CL$!&XC=
zWz<e56mVFIn%(mIy;(bFf0vE-9J_R8jxBm*o@n6wZ~=`YJ1-8}njdQFdqE$`1y)dy
z`y+_9NK;T&S<K?1f0xs)pS3{&3d-ktwKKeh=b@({(|ne{f{_U}Zd4!}^TBlc!{O4%
z!>A7Td^+aX7*1&fd~$3x>gHX(cZ%b0Nwux7H^$cci%zz-5d6r2-euM`jvF<u0}=ep
zmqBlUid&ol;81JeGBy<La8uaH0iBLw4(o?>@pRcvPN@UKP=kHS>%-{q4?$m*2mwUr
zteK|_qof+{3Be+i%d2=u6sn`-u4P&vN@yoc{n~azO$Lev#b`Ana6fn|TbT$tAbni>
zZ(&O1=$Sy){Z+o2g6^t2+tjhpAWxlu-XW)$lBNRN-}eFo3!ZhRT>Xb#D&Lb&IOvZX
zte@=Rv#rMj$`*$+b#?7a86SkD-kE;!V}=_KhOKx`WMsV;gB0qwRW!sa?lD=q-p<4o
z$#1l$y>OYu3YS4aWRx^2MF_oN<}8NkZAHO2w-p#go!g9ArI#Ij2Q=LbF$S!kEA207
z?f9#X1Nqsp!cNxl!+O7}t+#ZpWg7#Nv34oPk@D(Txfk$Hji+39mLTPQ@WkA)63Bt;
zA=qy4zuVocc)TG?#4wf9-F<O0`1cuErt}!99F-~IDx%Uq4g{mk9nG>e=gqbFJ;I)f
zn;V`J8>jQL36b?H{xX`5O_{KiS1hOuW!mmb8<+&rg}t`CpJflLC77dw<4EPEeKj2U
z#sX4p36N7(Zkqw81eu?Oen2u<-IFTaPRboIwbB2lBi+s-r9-S#iCzEZ{80`ac#E}&
zz`jcMWubC8e}M@Q<p7|ySwKva&7w4EBPW2uOA@<@Ed_%o3EOTfBA0g9S}Uw@c;f=U
zR}_S`1bgLsX%}SgetgH)Uo$3i(S;`m|BhC7!s~$37DsX|83tGka^%iaB{`n#^e)AC
z6Oh?|^ynq3IL5rv&&H1j(EUUOzmyRwP#l9cp+MUxh>romB?c}7)&*SGzNw(k5f1C%
zTSUPZqrdQl(Um38w@kei^#e2s+ZU@YGvR-|C~x9XmVOC2dL5)sFvei~x_&sleOP+7
zFKr{*xSX9ulY!E!7DwSf5tyNb!rG*2m}C5bnR2ARsCH8!49fJCEx&4?p;@OXF}q)2
z_X{Vf%8&8V!qRVV%=D@Xq~N`@Eq(n&Z5>yie@GbHAxV5gmb6h-f*zPdcIaR*=10Uc
zf!C{EVs7clWYm{XRD>=XI;KM{M$JV<+rx~iK&_@|hNLDaufG+UE@jyWb!wCQ)Y``6
zB&mwLMNo*^jkY_PuVV~!A|{Gj6N)?q7ov7*3*am8yJDV>Iu8pbN1DNwmIYQbL<5;(
zLUfd=m8tai=EoILh5j#mP;KcXoNzQlmJuC@3Smt*qlsMiOiKCp+CDT%gl4!^6UBro
z^}YVBr2q$9F^&<{HOpJ^;wQG!4F{o%2ix20X&IepcE^;5YYb0EbLD$F7}$q<JF?+0
z2)c=v+)({sS9l<Z_uI1EH82SOk#JtrrL;|a2LAs(WKrNSzGxZ|*9C#|H+C?s*tWaj
z%l<F{0#8Mm{P&99*oGoG{&S~C4`2>AT>E>$d8xE~M3bp17`3p}-%<80jLD&8`$2fH
z7{s76iDmH>N0gaCMWb5W2(FXtR2Sn8DuVBcNRA(=W`dRp5)lUlies`Z$J3j|#jfTO
zo<{j^=1>INsGlAjdUm4SMN}1K#sK#x4Yr@D-olg$!?p@+JkB3;*bHMfY8c@-+!W_#
z;-*tdh(o^w)A$>w&_$K9g*|6Ueg~D|NHdruBY1y@?DSP%p`Idk&9^-7umSGIy6b&#
z;`*I3Y#7z{GFeP1op1|>5wmgyUyO<?8|H>=E10lt-UhOD258L`RAzUGPFpb|z21mk
zIXcr+cNn`xYMxD5B%1tX(qE**6Uc3JP~kt(@}~ieSkSrDQRZ}doTM{l{1zY+V|RE%
zDj6WY=Br`1cfiMC4R4hHy&h411ORhVQ%evhr7#d%7h{u80v~B%<;^3_=z<=vlJuUs
z#_9CdE<Jze(BZ0^kWc`k^W*nUXR!H3R#|kqoAP(iaFD|d0BF3_DNiVOz*GA6<0QbQ
zZr1p-i>I)0rY8a-hDVQ0?D5tXgTeyHQpK-~bBAb9Fp(_B*+3zs+Ni!9imyx~I5%!p
zY3jH<>zAeu8YE7!*$V*H&Yc*ewU+)kpF(a^i6MV-<fn;guIV+Z+ZLwsoUMcbkKLkb
zc?qxy0k%_Z&+nK^U~-t|gt9$4+VknZzh0gH7FQr4;GNZMy@!pZuWTwT?VE%{q`sC|
z>Y8eZ#QliNXwE}8XoOsu$dmcgB3w*o?tNl8k<seWLtDUVNle6_s6>|l6x;Lq30svS
zZc_l4j*BR&gdhsf=doX^_4K24wv)CMB3i?X=^DXLG~Bxz)mfPgV_+Tv%O!n*)!$59
z%DxA)w}J`Pg;{Pd-&%*FT*$X0_`+4u!riZWl+J0aAJCG3AaP>Mq#F#~?z9Yc4>`Qg
zwM>7BOk;_Ldz(*A==}LAps2zaf%^k8aX{eV&={+LEeL%XeEPt2($ks>CEu1s>=9+H
zAA_RNM0vn`)rc!~#58=2{Y82I&GTY?yF7`a?)j`OhM=Ekn1RGtmB{MG8%UuS)U0gh
z30bZfQaDSUYWuiBE*xanTitES7*dbW6gd!2!-=}CN;lp&-<Ddm#=hXi%(^-qXI&x%
z86*y211W6cvd^|b(qpm&1%QJKq!%yOj`H9=Hn=`r?8Kgd{6lzc&f2^3r_;z0d9BM^
zqEx%b6D$a9n<<Z5rH+k~_}PNFeN5Dd{MP|ys!IYxl+^5hV%{Vv&khf2*vj{1g%-`T
zs;HaRr|Bz1igt}K^(WR*Z|}CbdbuO7#ZE##R~v&<-@w6U^h9b%3&$Cjz}nCzfXJhr
zA0rvN=<>35yQidF#(e3d_MMPV@6vH>?3^B5Jl16${W~@Je6FBo7Ko_a4?Rjh5xxCi
z;3>6N*`s9%W7w51mQu>*)e`*`>vWGe>ov2jDB7DEcd^{TEX$Q=6Pw7pG7y)3iw>-!
z=!B`Y_;Pu~rb?gxTS2iEGyk*lW4_1?`7iT)CJ+Nl{jJBx&+;i-4+cPbAH|m>#Mnh>
z!mY;=PeI22GiC^V_e?F}vRI`s)S`gbA10Elcw?mTK;c)J14UNVO$xa*zE?%C3eJ`}
z*$Jr0BM_$HS7nUYyp!t;5QJW-{VH(($~Bq_P^hhQaYG)&)r6CQIkCFRgCD8UuVnJj
zv~|vvBNqd^NeUpNeTLlOKMHMtoTryHYrGcyV0tgWdQq+N*zL)BZ_m-jP^mp4{;=Ro
z_nhn2ToOL!l*LLGO{Fo(s8-FGLbs>0Upeanf9#UtJ3n^bcIJ)Tlo8IV;vR3g|L2dM
zt$Zt}iv6)W;X%#qqUO9&E;8$qQl02=ck7Cdc=bhnAaNfB`-p$IfoZD(-P=>xOn6|Y
z<`xgLM}poUX>bnaHRoM1K-@Z@zNm+;&nFf%?o;2eQfCqp;%Xzo7GJZ&tt%<n##o)M
z7WA0-VxUulrqi_Dwb>JD0lc8*<Mg`w+*GNHq|vYB6`P&Ea7}xl?#+TGR}d==a;K&e
zF!+yOOFRKHm2^!>ZNspHck)Ue(N1n=p-+t$0Uk&X<8i3Eb!xV!*7rZ$xmTl~EFsH7
z-uO7pUWS8}!c~G|+n`neyw7-4P63^9S&k{h+#Y;xm_hHc@6{6=4qjBW7Gtm`y}tx8
zmh7kq)<mS0c|VaU@lj>1W5T+Kdx0dDFpkQ4PuffqEJa_S<n7fs&Q1BFPri9__z>N|
zUel`PIpIyXb71XBj^mC|dV^)!tu!Jkz^dMlEq0Z~Y3`$-71UP=uA}$ePiUE_CP0%M
z8^!snF)sSk#349_0FqTyk<`eEZ4oQnH#{Z<dOF=2%(#dukyc(^1gHAdk)xFdb7UgU
z1@=7S-rMmA*`{^%0^<E*PU-|QKZc%%m`XRs7qCqMH+T{=3xmETWAV1o8EKQu^+L;?
zrt_{zGr6r7{keG1sg}`kB4;~ed*=}iMe=EIj=-2UYuF?)Tu7HW*6?@t;qmeCC6>tC
zUAE9>J>d-{+^o<jb}Q+9;{bPoQ)p^E1BlUYqzmS~=0~--W6L*@>BKbCUmi%HV-qIR
ziNo&p*JQsBPMpLfTy#>}(Fx|a24Ugw=G=t+UCOD_n?pONT=Mtzz5>T0{H<jbYs&=3
zE$gIklzVxf5(gIQweh3(Fql!%e%y*dyji#nTfIYuF)}$C>7e;~YSJFKcL&ccwTsyG
zQy|o&`5pJ*3`mb}%~<@RgRIe8+M}qqnsj5!5sR%#4+~fQ7Lr}d#Zj4yv15=PKGvPR
zuvv^wPnZlcB58xw+ZJ<AS>23~GRVW}0eFPa&s49eZBIP)1*CA<KuEKJ&~Wv>{a{L3
z!|Ff6c4&Kb^fmWF%J-8OqfNw!;&kXq0&gSS+H;Ir9Q9P?uLAw4NQ3be;!Dd?>cS}U
z+mS#x?E#Ce5M8erK;;Vzx>A5xpH5Ed!z;#lU=vl$FAyUm@JFy!@>8S;&%_|sv6a8(
z;sLn^@NA*{bGwuN{wO2q!Bj1E{5W+#y{P3(1~Cgmkm$4Jxfg^lLHlpwOUNjE`+nRc
zmDhq$_)Q3reuVZtiXaVL^&#DYjSUB5Mj`U@t69ka=$YO!xksN3>;o@;1F~eTp~Zo%
zLZ(4F8`VuWNHkKq;lGKxC%_^DWTJRs2HT<-`z$p><4~QQRNyAW8IsWlweg_~2X&)x
zA4Ddub3+s(BJC9BxyJa$&r}kT3X14K1qw?H77<{zC>wvJ6mG8p*7vZ6tKE0JBC=-K
zURd&{F&$;D2P^L2zi{x}xnSf4UMsu^rUT+=D*EALSt<WL9sam(ABf#AcKbjKPSk;U
ziC|C1_coGj!71xAPK^^>#ts2D*Qn^idd~vOV9dP4hB=87F9Fi9?<ybn@TR4UFR_E`
ze&#UKNhL4%>F#x7A9k~rp?8iWuu0IxVZ*QCpeU&7{Vm(0K=!a^9>{c`IjysWq<EMR
z+Puky+b#iOG^OL8BmALu|FKcX&;aXBz>T4;PF{dKM*La0jBwRvxr~!Ru>E&tEkBm0
zcl%tPt`B?yFlY-gGpTu2|KU_P8#Sye9Me-3JQN+{bhrq}?iU^H{n8QR(fcUxOGS%v
zbt1mADhI)=<E6E*0f<lz=ID$Gq$PIg$R9xZEhyq~(GqnzfuNCgux2)DGao;g7O=ud
zfw4LUUB<)}S-9bpX+E|~p=U};p(C(!0oq7}cjaTy&ueS%It$Xd^~ko9a(04<->uK$
zGnly_;4&4CpHQS`!nTC>R&dGZ3&uSp$@k!9b|N4(WCyGyt;xSZuWarVl2PwH#!J}z
z(xzU$d_=7}evH&v-=o~BE%H&{9IP>Z$R7$uOFR4o-yjh-V7Aw63#qtom4x>MBVM<C
zx7>`)bU0_m_;j4Z@qgBOurMp?BFnvUI)ikD6-j|DM(v?TA7%rQMrm@RLi2q6*dewd
zXfW@Ik|+V225f_BQbn3)dY{K+l$EUg84k%=tcW8f+K&osk{Od}G$stj@zAXv$B|)U
z5$-|azfoZiaenB|P{$k~;M;GA73*T|>(m={2(kD$*Udw6vtPn|3kIp_i+@F>7{uhp
zr}t3>KxdKgWciEiWCFB2ZRNy$9pApW38!em-LYLNd+3m4J|viNrp0CAO=qkw;w$iy
zI^hI&7)k-ap3paC>hGv{zqsgr;s4{3GRbBubHzYPQaPv>w*zfUUWd7lT4L-@%xr85
zpFFDRUDPk0drgdjUtNFNHY{hWJ+{=m`K)CU0qnEFp(NwC6(leX;#QaX)`%)NeNejH
zZ-AD>4MrnMaSEfbg_v3HZVEd3_4_scyw8b=vJK=y^`YWMg-uVyFw7GAl95Q|D=m%J
zXp9tDwvB!G9_XVhhUI)=Mg$fO%sGjLlq|e3>G8YB%y;}DqJ$;QH#H#<joUpjm5nz+
zF1b$}ntm5Wl@|XgK%W{55R8da-b}+$NIiEwLC!l%p{7gcOH4XQmcWt-BiINxmkJH7
z*kpP;@o$5)Kiq*!Hj9LfGmKLqTE^1$Y59Agh*mYt8f6Q{&glzvbU`PqO4S-!4Y_ig
zaoG=VL^K;|tI&Xf(JlsqF+muv1L1@a!qbE2xkBYiB&Wa*co`N=b*V^K!nk(@kNZJP
z9j=D#PVKQLU(vbU@4?K)qB*@)uaz4JK-8NCJV*zJRKPKt=&^>e$-zMtU2Wy=Y9#=l
zH%Y0c<`b`m=N+Z^%N8Ng-T&hBcFK{U6L8pNe)o<63R4A_=9DRyx-Lzp%$t*z=ue_n
zl%7WqISP>MI!e>rYG&Hk)_lSVkS7a?VeQ9v#scwZJW}QhD7_l;8%MYStp<(Rw}`os
zt3Z`0aVOAu6~TpSJ6=(Ak-?Qx9$~S%4drHCl@i7n=Lf552s<dEx=N?Y4a3`7=GP&3
zfzcK*HCRZ);OyVdj4Qi?^gfTp)f`qc`{^&avk<GE;5h@2?bD7C+0KQi0)P+OH8I7i
z%}uP2H^aCimYd8>((iyjXU)3`ZNY&&gz_>yjC{SZ8}+q32_w0&6#AuP6|yr%6^?WS
z@$5jP3+5Hd++g$_aF5uc%OI8uHal~EtgWhlXBnh-+ad=;y8~fpJbW5-8p;7uHBg1Y
zOt~m18{OEEvFcT}jc@N-3J{zGg)7XL=!&s@747VJ(BUB@K|OW9jh87;Ybc2_X9B(~
zj%7g(25+@{d@7}NekXGZ=t=2#0fC1M9%Z@Q=1_^Hpk{rE3+8&>v`_$-7I83n1-qfK
zv4f(1?-qH&%Y|EX7)hU9#7U@T@XtCD^Mf89=@KBEDZoTXpEv8uV-ACTpUeW&BoZn<
z-U+3OYWKCFK4QGkZ11Wmutu_JvSwyiMrueJa&=^82=nO8X#BM|PnEp{+E^b4c9$w&
zLro&0GPZnXw>qKRXi!*Jx>#I?*B;Z`4gCK$-Z3KpTdYR${SB0TH<p~tW%1sqy^Qc$
zEvcB6Ib5O^`yy4LDu<7N&SijT0#v$z%@vcNlTyiWk~DtPBGF$pTKq2RU`a#JCl7P(
zkerW?bA~;ZX8yXIOGA!GgO?nQ0L$8+l5QpBL}k~Uk~DX<&8BY6?{gYSvn=3<Y8In*
zng>M%5x|mikU;<a-$O>g?z?Rsj&q#Bp7*TRuUuatu$x05hb%yVUCQfgAg!t#7=r<2
zr0!yiNn!n?4C{pw;zIUavGXu`U^~UqA<fgXX}tSyNM%qNW#=P^*ubzV9?*?9wqj@0
z%dm{3nU<tr0@KlM67xg6;~8G3^m?w%Pa7vr_&fwV>F#_S(-4{E;GclDq8}F06IMWa
zhc1SE2^V0*r}FwQ`c4sU{LoCL7jiqQBRVg=1BlGM1XH1uygrRKNK7M_b@YrvVf(f|
zZ^in5I1O-^Aszk=8U8F9gOBo<8)Ls|TjqfUGk=t$aFOlV-g*0cTxtwx_43J<3(i0%
zOFo6fOqX4?=F$F^h)tTwqreT51A^rQlc9(avxAkRpE2DQXqlu}FErM60R3D;nhD>l
zCFF*`a^D0^t$ZKR6M&_qLY;RdeW<B|#rYvH<u4-5@{oOybN_go{k9Y3-2$@5&lqx-
zCe`hNJZmc?Qd_y>3-1~R<<y~Cpg!twc`if>T}PH*^&XhG<5s(n$sG8!l;<yF_znE3
zuz>@ZGN5mkVk=qe8`q|8=D66HSv*s(X*{IjqX-YgZ`%o&MRI#Ge6VM0Qs84D7?cJ-
zS;5~WSGd6~VatXzfs2+<D1Y)Rw)lik7UIPho!cTPko@T16IK3E@I$k6{utO%oI*@n
zA#N+ogIk$%{fl5CbtAYe(U7_^Y%i>un@spix0o**t~2c`?l`{T`9q?R6w0s$S98DY
zfD^Ot_brQ%aZ^K-+C-q!6V1M!g4jz8(*_^o#!70u5K@S&yFOWPZz3}Gn~uA>C>*mi
zF(H7t=sQsH!rI&j6{`suY=N{ddGK(NNeGpVg<7gInt}*NBYLXkNRxISUcIG6oW%tM
zFVokKK!cMVeLq<^6=uBK$IX<tF&T-z*lr)1bWzvJike%k>!d0^;RlvxRsph0CRKG6
zdwE^qNYrrQWX6~0X}&qSfva>-8JLi_=OFxO^;c?l+G7b$CX2cAV=@+v5$jkZ^MudV
zFD7V@Hj+k|4Y_Jl?~rc6)WRy8Lj`7OGYQiM^9|6hZ;6)tjwxBix0DrC2e_}PNnNXo
z6Q`&E<$x)ffp|IBTvqF#$SM6v_CO2%6p{e>H2j&{GC;lUcTb;FMW<yoN4PT2gv;@V
zFb?b6w}>HZ_a2LC<AO;O$om8xhif4UW0{vhl17W*uiJ9+n9aH>o7+8ao9&RFF9jcj
zi2w^$RJAG3C6-N)n&C<4FkyFAL-?|MH%@!Z;kdSnvYOZJlDA3!DFzv6KQL5_-Fr<>
z-oNn}+-RZ-kQYtzKH0CBCs2&&e5*3gR|c}?et@ez7BKkL4kb~*&^A!Xxc_wMuM_|A
z+<R|daT7*lU|s@>vyqUGG{e<7sw6aRgLvVtla;1PwKn~Jlk+i`=|XvOm{E3c9t%1V
zrgMu>J>Zl?!pNY)k2&V$XKgDP#>)6xi9{MHp8AJMqj+>Z+GGhF(ou0Sc;;`bim*~5
zdN%@7XW6-S1C(Eh{v09h#p({nN-!os%jjkQvdj>S8yVj|&QUK<5OB2x)okw9+15J{
zPQJM_T@;V}6;gD=h{k)uX%Yzq5PiHfB2N1H^{*uDo^m4&Ht{L{b!y$^#%Mt7Q}&Wa
z^K~l1yP9}ODiKnALtO&m6te*QMYjt~Y1Op*gr`n<J6$cp$-*a*!*G4Tv>U4hWUe;(
z_y(^*PF@&=J*Pp0Kb-)v4GRm7JNU_a|CFuG47_fm+Cuxg-@l%@<RO&``FNd<!y(*i
zy?ihBKMCq8ZQB5V!X2xL6e=mGWwa5Bn{qjwD)(47Z*5-U96pLFGea#hONS27%*(kH
zotOP&7aLBpbYfXIr`u!|dEtyWXS?s`aUT<9Gwasc+1ikfdlqGa>f0MoyCu&(jZ|z8
zeWVbxyqAYnn2?)tL@F|#qkJZgSS<kl-xJ%@R63C(K}~3p2E#QdIr%Qj4MBH1w*MuJ
zf4*?7b*Knm-1XZ({nxXkU7a8K4wcAE=O~77XsONI$Xgrz4J1N{XkF%^smC1E8FBzB
zVM1Yl#4)a6@+SY(P6TKpXdWGx$L6$h`q9oepv@(Xe`^G&Ql&ruUi&$~wu%c<lxdGB
zt2!sxbk8ZjJpF8Ob_$%$4g-S{|EE3CK+5E1<AK5+t1b=I{g=HUN!_|meUOQ@MXO(%
zX)mJ8>y3*uLywH}L>{fwmk{(RB=QMQrzVZ1ids9u*k|4rGqU)3MP{GcYdzMPgTd6P
z&@=*a<eAA53njNmo1uN^>Nf`y2sfbVa81%~cFW&ATCrPpx<Fhj;MzEJUeUapN4fV>
z+D4p7%(%Fo%b(!4gvL|hp^oG%*lWBZUNvqdzPPKZIzgJaU<0xe*9ts=r+yaiV4i<i
zHKC_N`OC8-)m}7m6ir^G*C@?~uPMju)Za<yX!QkmL7&~jk)yZI2@I!H3SvETDKe$|
zEC2>>){fKsJ2<2-8y@g3gbdRvC?q>9mQ@~sIV`@rOIJaOy=o{2{2%Nl(f_A<C8INl
zv}2&U#;?X?A_>*=mA5|f`G}FA3KOjS!Uk4C6L?uhezB;%k-9KS#?^=_9E<?LB|iZ^
zw7|z<wmg)UdW({O2B#-j1kN}B4dG|%!YTp6C*4*)lQJ0t>;<Wl*egcm+}z9QaP9Oh
zYe5@%P%+ciAu1OB=}IAJ{P|o7qO(3JUo;3IH{n>FlC6@EXJN!-mW@5r;zjy~aR~M%
z@qm;|ovA>`TIA0ZM;^7;m#iYtU4%fS(#Aqo?0BVQo?s0Bs1x61hbI31GdIMA_<<Fb
zTSGMc;9UF_Av}K7ycsH}XgFzEkEB1JHuI(ea}DNv-JF6vMww{bW-UsyA_W#z>4;(R
z_+=j;0nCW4MN)yk#Q7_Dq+&JCs(pzc&j=!n;4Ya&=r(#h-`%LQu1t9No(v5pJUCLu
z-=uIvt|JBdItOQ=4I4_R`9`bw^E4z~(1Vu$yubAGugo+>eLC4df4f~8cs8tYyM=^@
zCl_bV<Uv%EuiYlfr{{^;{EU+-y^NGO1fgJp@+)8wv@pA)ZVrhoK9d$<#9bz|z^?pX
z_YQy;`TMzlvqiWn4fG<q)c-=@>3~?NYyb__dQi;B1iR?{^{bGHf@cE!vwi%tH87UO
zJ73WPs&SQpk-|y-FYX~Fgl5xcq!b03GPL1kw%C$``9?qU`zG3_THmx;ph6E{<=onm
z2XU5mLf+NYif@3{0eIS2-uqXX6Uw6?QbB=(7Tk)gxI<5Wh)c)73T}|RuiOwA>*S7-
z^rns!|LIS@X0R?o;;RSe?Lww<8K4D6Al6fLA8>L$ri|WE&Q7zp@R`i5gzBlR?wU1%
z7thhUb)T2E$bPv=IS7iW>Ri9=IS%ZHSiBT94-nyo!xw^<C$ex|bAPW3!B;Z4NJ}s`
z$x>;E%1TR%tnUdi#yqpl%bWs@*N;TD3>L*OQH>NJw@bL}RP~G<CCJ-vbkXtSVawAm
zRPt39vI+kqmjEYAhw879yDXS@kFHHS=!|z07-KAOrD&PI10{VFHyt<Yag$b(M;FVf
z`6m?R@Vk*2l1VqDo&`Rhh#N;O9!|65Pc1c_Fp;tuzj4DisM;>hpvAF73#y|%B<oHT
z!AVTT3-!Zo`8ZV&pQnU>(w$c1PE)G`$LgVKhYUSnAj;0NwYwu54Hff%qyY*kO}N|i
z^g`B90>T1F=K87c`tei#jwGOX>8+NMqNzaYD*Nc*x#UcQ>z)pTT8`n-$j&5kKkDbs
z0=U-0KAzZ9oPgCeHv{7^>V=N3l5W<=Pm4EUyXs7P2xlnvs>Go@xT<W=Oh8U~XRDyB
z9wM;>LMUT(fd>`+Q(~#t#DpMrBk?6ogk&Y4^>Rfd92jT}a4RMNFa1UyUa^_vHDa5C
z<926)?(qN0VVjk@M$_pnBobKN*#X^ypPeE#+0j4wJ9I$*=6g;~^ov;drfE5@@hD=*
z0|RO)uEK?2&{P;;>mp~>SdmrBUO+Mz7&?DA-Z@NA(VJ!lBDFyY<Ru_ymC3MUt~sqr
zC|R=ZJjELRP~L{7lk~HW^2#mVk_4vQuxKDf`mqaedRwqp6`OM1fapE6z#KU=3*46!
z<&j@^m2wy<#&E(hM(g9${XPswMzHS2hE;~drZ*+5Mz%n=hqdgu_tTsu|J9Kp<b_j(
zuDw!GyxE_zYHi-EQ10ytPhE7#MC<zTTYwF%n)g~UOXB#tzG2P-;q#=*B^*_Tht4MB
zE?H!-IuO08Kfdq}5WdPJAL)Ii<P%*#G67$2^|l&TK#LQln$3dGFDPUl1{}Yu;CK<r
zrR-hC>CgQ>VoIm!2VI<(3AKT0*wT!6vXr31(v{S^9@C+YGHh~4#EAD!@_n|S|F-FU
z8q4QztT??}J)}m;_-KUY?63bP_5;OVCK+x^<ISZWw2r-ecQCD3YKH>9JiJ1}o6)Ux
zJL-kG>;SUFd#r@t(ew7v*d|==AoH&Y_H2nxAPyoGJ(l=^l+8#^EK-Y*gVz<WHMjP2
zNudFF+T&?yK^H9_pcCUi;5U$mTSKg=i8gD>mL(A~PF6=34W|MwiQ2l;lWGCszCvdW
zQ7YwZdXJ5{tiy}*z=CEtJ|?N$1*Coa*h%<s1OTaNj);Tq=Wg?t{^cf>8%<Tfe60cI
z<J!mm=0`mV!pJNxaNdMT-HsG6n=$oQ=OvlZ`H=j_{wstz0AuDpkLXS^ZXQ`7WN!;S
zIh!tT)jnKbmT#6=uactY({5Y8p=jBX9uRi`xkL8W92X8EwLR71=fc;TK*{@Pk+Cf-
z3@)-QAThCMSL|z)x_vkI9N$<atNvPEih5L*eHfQ}ns0e?eZa)7Li7M*$26A3WRA$*
zNkf5BAj%wW+S#D^PrjB0epK>uZ(<@_LNA<}5wKuCWVH!?E`H_p0nBjbIGPA6bj63t
z8G*dCg_v<bRdN7F+fMq}JW)U}?`b+n?G>>y+R3*GxP%T&or2vOAGa%-(~yQlp5lOn
z@k=j|U35X?lhjww3A|_Yqm%$&750ga%~mS#pBIMS3YSdPlhw;aGjybRifzR<zlO!&
zz>$uH&j873U{@(wGsfhzg}ZXI#e^7H^O4+X1pW0%0EiT>FeRlM>yO*2vw3g|3k9kB
z4+l`FRNA<WgtDxiO|}hy-<>*%jxLTu6RpQeU|R(aK8>{}`A?C)eXmb91Y!GF9nhs0
z?%#sakZs=+l29VW_d2qCl>Sn^)K)Tp2@)X<wU>l&{RX9hGYjSwLy7&c4I`<5S+8N6
zgyZw&xJQ>UKpBFY)^G&eeaVJ1IO@v^dy0m9eMe_}kS#TrTHR8X<E~gD0Js`IfP}zi
z^KNQ6o)-7#18sHH7(djg*?{QEjQfft&S5qipe+>=e+_8oWx=?$B_QeXjxt@y?fH}%
zZ*1^w#ktHM>m>E@wTh`Mu-%GIjjb}D42Q#3u>|(<Txx)%KoiP&p$G~l@wS*S8%|#K
zZ7|KVZWqnc(t`CA>kqOS3i}l??$}B&=c3XkTGNg58+&uTU9t~w2294FXa2$bhdzL=
z;qg25ubRQi^TMHgi?>~VA);U1d-$Iz`WQ+>us4p$Oxz7lqQ1Xf8lZaXEyE6V>nU&j
z^8BHGGIgPwa`#Opp_EFYzlusi3N4M`+DeT7yD1oLKu^`A33+#_lNk{N%DZ%w@#Ue&
znSoCx-+VNIqh)^T#N&}+e@)}X4dPli^f}iBKirnt+&_DM-Ju>c#oNI0Oh4we{)?*A
z%Pro2m%Z*%ui5Z&^4b}-CO_Z$J1Q_vQUA;z)REIvQFZXs{^}W_CoS)st=utBZj*oB
z7K<KpF}<n0i#BCsWqPvf?w)#L&7->u<qb>3m*r{X+PKI(EaDNZH2S>F=FBGE&kOo~
z8XQ?#^H-w7%{}*sw@bUf>zTYw0*n`IPTt(R@KJxYp5BRdtDnrPS6jbS)oQt1)|yK@
zB%1bq)jZlR{lH2>>pFk&V%wARAOGy)%si2_D!NB1E465f2BYn#KU+Ls&Eh^go%M~w
zGPOy4e?&q%7Yg5t{Kv3vc~RPK$HzzVT0GNjMc=Y>G}rH5;5AosHqVa9aa)(nDP3bG
zAER6G|EAE&FUJpSJ$lYRH^#x?>^gBF4K1x7Zkzv_PG>)~{U~#~rDnp<`Ae64n7hC>
z?C<N#Ou5&NW$XV>ImPa?wr9<Y?d2zL+ShXSeS6W<Q@g9mx>Y8m-L}tp@#c*z`SX`e
zzf>Upe0BAQ^Pc+5-<w}vzQDKo&GREI!oPJZ_e{50f8<E!O99DayEpRfytwT}c-s6w
zHFcMx{H=ub6jYdft{q`Z(!R7Q{pXGuwbM$%Dj!cj((*UL;pNjgTbO|Bc4mEwN}hN&
zFZxUk>)RW(t8<hln?CHE@Nw2t&8#ejC{|~A?n{hwQ=FffO+NLnrqx`w`A9^I=8f+>
z?{2To+w?x|1K*Ei-)o-*W@~IU*YR@tbarX2X=R<QXw{a#r)Pw&zI!K=L(;TMVyjE~
z%i0C&r|D%c6JA;Sad*VVxzW?U6!S2$?YSO*v{6HN;<TQ9FPe6)Tf%L-|9@z~p9S;x
zuRCUSuWkkVQt=y2tNq*FFJnkseaRwV3-9jzHL~5k&7pkr?k?@Qyf!*L)wbX4<_5;u
z=O%6ObGdDCqF-q4?C)=Um4rUVX1e~YRgS-u!?yByZse=h=BYL!%^V)-Wo1+IUKH$7
zT=(?(&FCGIeQm2hmv0Za`{Vh?-G{RyZ!t}6X1w-##gfP=0{^6s{56xWTgy?tA!XCm
zO16r)eFqD_3OLIB_GEl}yl>YUj*IP^mY8llaVyfVy=KZso;n`APkSZrCz~C4e9HXE
zqSkK>$1i=2&$p}#=}TX>eUmrWMKh(CT&60$_2-r^UDW2|zBFkQ_qtSPr|BN@?^<PU
z`1+re?qA?KVP5Q(zI^jnIUAoQHKmwt$>`VglX<+#PdztzVu6mKa_~(D(QKx`!+HC(
zbvL=Ka=rDbSMTeY!%B&tlNqOYm28_8P}j(_ZK<}`0?*Y3Q61+G<y56h9_~Moz24la
zY2CJ{6_foPP2X@H;cB|uXrq6)^@@M_?WeyMdSBsMw8hR2c+~aL%MUu%tu2+7h|$<o
zbJfHzG_+oDd&h^XSsbU|zlhDeWYsGed}T|2$;9fgO&479T>ih4U~2z(?ch1D%fOj&
ztEMJfIjP3S$NW<QqvhQ~o&+yYHU6DCX@^m(#lNuscLhT3x~0S`pZc-9Qd#c8kzaK_
z4k_G;pNz7mA9}C8$Y!^x6Q98>LB0t~r)OG=PW*Cq?uRSBxpVv91*<CEGX1+Kz3!@X
z$BqZnr<SX4pLy_Q_1l<5LJ8X^2XxC?O|@n<dBPoIGqZ2nz21NCm(}Q66uvsJL{GO<
z`_hWoLyk8?K6X7}XN@_?F#AQxlG=`f%4~&vHGy}>YVH6J=$&u<dbU=4eU1Bn^DdE;
zfP)-gIihDB^i|ux@loLPH(MGX9l5|{;w>%V{0}%49J4s_%h}0qrk1EJE1wpa{IPn8
z`tdn`KB<=;18$7eiMgDcvaHW8`)jF6fWw1d=Xs0FA8%V3Dq$#Wd{ES=dUi;i&vAJ^
zgIkUv3~o!gCeMw!@23mAcYrTFH7~U|vpBxEq$o2l9eNYNR^a6TpKqGEnlyPvS>D_G
zc0-WH_wA`%OFG$Vs`DL$SD*P;CID1IJw>3~2te0&P)0&rpUl8;H~{JqkeNWB4!Np<
z-^l^Q0|KZx!wLp25D$0*!>a@ahEf9thV>^PIB^9~0(6T9kPoJT6d1VPOxXcrLyScj
zH!2Pb0SHZM_;f(Db?y5P1rUCBHI#k^rT;<b9x*7b2c_MhbR3i}gVKFadKr}72c@q;
z>30yimkmnGL1^@wI~YN?yMO>J`3OR|a6Z!|r~r&&1|=`x4K2J5V45JoECo@bo&%vZ
zpFn6W8C0721%%JQ@OZ-!rx|}_L}vZ|a$;uwP8Icaj!#l%Pxe_db*6Mh(2h_-@=$Ya
RVCJFHy=D-8?=e`6004n#Dggih

literal 0
HcmV?d00001

diff --git a/concordium-consensus/src/Concordium/GlobalState/Account.hs b/concordium-consensus/src/Concordium/GlobalState/Account.hs
index 4d78c92db..cd9c13218 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Account.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Account.hs
@@ -27,10 +27,17 @@ import qualified Concordium.GlobalState.Basic.BlockState.AccountReleaseScheduleV
 import Concordium.ID.Types
 import Concordium.Types
 import Concordium.Types.Accounts
+import Concordium.Types.Accounts.CooldownQueue
 import Concordium.Types.Execution
 import Concordium.Types.HashableTo
 import Concordium.Utils.Serialization
 
+newtype CooldownQueueHash (av :: AccountVersion) = CooldownQueueHash {theCooldownQueueHash :: Hash.Hash}
+    deriving (Eq, Ord, Show, Serialize)
+
+instance HashableTo (CooldownQueueHash av) (CooldownQueue av) where
+    getHash _ = undefined
+
 -- | A list of credential IDs that have been removed from an account.
 data RemovedCredentials
     = EmptyRemovedCredentials
@@ -256,6 +263,19 @@ data AccountMerkleHashInputs (av :: AccountVersion) where
           amhi2AccountReleaseScheduleHash :: !ARSV1.AccountReleaseScheduleHashV1
         } ->
         AccountMerkleHashInputs 'AccountV2
+    AccountMerkleHashInputsV3 ::
+        { -- | Hash of the persisting account data.
+          amhi3PersistingAccountDataHash :: !PersistingAccountDataHash,
+          -- | Hash of the account stake.
+          amhi3AccountStakeHash :: !(AccountStakeHash av),
+          -- | Hash of the account's encrypted amount.
+          amhi3EncryptedAmountHash :: !EncryptedAmountHash,
+          -- | Hash of the account's release schedule.
+          amhi3AccountReleaseScheduleHash :: !ARSV1.AccountReleaseScheduleHashV1,
+          -- | The cooldown.
+          amhi3Cooldown :: !(CooldownQueueHash av)
+        } ->
+        AccountMerkleHashInputs 'AccountV3
 
 -- | The Merkle hash derived from the seldom-updated parts of an account, namely the persisting
 --  account data, account stake, encrypted amount, and account release schedule.
@@ -275,6 +295,20 @@ instance HashableTo (AccountMerkleHash av) (AccountMerkleHashInputs av) where
                     (theEncryptedAmountHash amhi2EncryptedAmountHash)
                     (ARSV1.theAccountReleaseScheduleHashV1 amhi2AccountReleaseScheduleHash)
                 )
+    getHash AccountMerkleHashInputsV3{..} =
+        AccountMerkleHash $
+            Hash.hashOfHashes
+                ( Hash.hashOfHashes
+                    (thePersistingAccountDataHash amhi3PersistingAccountDataHash)
+                    (theAccountStakeHash amhi3AccountStakeHash)
+                )
+                ( Hash.hashOfHashes
+                    (theEncryptedAmountHash amhi3EncryptedAmountHash)
+                    ( Hash.hashOfHashes
+                        (ARSV1.theAccountReleaseScheduleHashV1 amhi3AccountReleaseScheduleHash)
+                        (theCooldownQueueHash amhi3Cooldown)
+                    )
+                )
 
 data AccountHashInputsV2 (av :: AccountVersion) = AccountHashInputsV2
     { ahi2NextNonce :: !Nonce,
@@ -293,17 +327,27 @@ makeAccountHashV2 AccountHashInputsV2{..} = Hash.hashLazy $ runPutLazy $ do
     put ahi2StakedBalance
     put ahi2MerkleHash
 
+makeAccountHashV3 :: AccountHashInputsV2 av -> Hash.Hash
+makeAccountHashV3 AccountHashInputsV2{..} = Hash.hashLazy $ runPutLazy $ do
+    putShortByteString "AC03"
+    put ahi2NextNonce
+    put ahi2AccountBalance
+    put ahi2StakedBalance
+    put ahi2MerkleHash
+
 -- | Inputs for computing the 'AccountHash' for an account.
 data AccountHashInputs (av :: AccountVersion) where
     AHIV0 :: AccountHashInputsV0 'AccountV0 -> AccountHashInputs 'AccountV0
     AHIV1 :: AccountHashInputsV0 'AccountV1 -> AccountHashInputs 'AccountV1
     AHIV2 :: AccountHashInputsV2 'AccountV2 -> AccountHashInputs 'AccountV2
+    AHIV3 :: AccountHashInputsV2 'AccountV3 -> AccountHashInputs 'AccountV3
 
 makeAccountHash :: AccountHashInputs av -> AccountHash av
 {-# INLINE makeAccountHash #-}
 makeAccountHash (AHIV0 ahi) = AccountHash $ makeAccountHashV0 ahi
 makeAccountHash (AHIV1 ahi) = AccountHash $ makeAccountHashV0 ahi
 makeAccountHash (AHIV2 ahi) = AccountHash $ makeAccountHashV2 ahi
+makeAccountHash (AHIV3 ahi) = AccountHash $ makeAccountHashV3 ahi
 
 data EncryptedAmountUpdate
     = -- | Replace encrypted amounts less than the given index,
diff --git a/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/Account.hs b/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/Account.hs
index 7b6835ce9..789acb8b4 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/Account.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/Account.hs
@@ -28,6 +28,7 @@ import Concordium.Types.HashableTo
 
 import Concordium.Types
 import Concordium.Types.Accounts
+import Concordium.Types.Accounts.CooldownQueue
 
 -- | Type for how a 'PersistingAccountData' value is stored as part of
 --  an account. This is stored with its hash.
@@ -54,7 +55,9 @@ data Account (av :: AccountVersion) = Account
       -- | Locked-up amounts and their release schedule.
       _accountReleaseSchedule :: !(AccountReleaseSchedule av),
       -- | The baker or delegation associated with the account (if any).
-      _accountStaking :: !(AccountStake av)
+      _accountStaking :: !(AccountStake av),
+      -- | The cooldown on the account.
+      _accountStakeCooldown :: !(CooldownQueue av)
     }
     deriving (Eq, Show)
 
@@ -126,11 +129,36 @@ accountHashInputsV2 Account{..} =
               amhi2AccountReleaseScheduleHash = getHash _accountReleaseSchedule
             }
 
+-- | Generate hash inputs from an account for 'AccountV2'.
+accountHashInputsV3 :: Account 'AccountV3 -> AccountHashInputsV2 'AccountV3
+accountHashInputsV3 Account{..} =
+    AccountHashInputsV2
+        { ahi2NextNonce = _accountNonce,
+          ahi2AccountBalance = _accountAmount,
+          ahi2StakedBalance = stakedBalance,
+          ahi2MerkleHash = getHash merkleInputs
+        }
+  where
+    stakedBalance = case _accountStaking of
+        AccountStakeNone -> 0
+        AccountStakeBaker AccountBaker{..} -> _stakedAmount
+        AccountStakeDelegate AccountDelegationV1{..} -> _delegationStakedAmount
+    merkleInputs :: AccountMerkleHashInputs 'AccountV3
+    merkleInputs =
+        AccountMerkleHashInputsV3
+            { amhi3PersistingAccountDataHash = getHash _accountPersisting,
+              amhi3AccountStakeHash = getHash _accountStaking :: AccountStakeHash 'AccountV3,
+              amhi3EncryptedAmountHash = getHash _accountEncryptedAmount,
+              amhi3AccountReleaseScheduleHash = getHash _accountReleaseSchedule,
+              amhi3Cooldown = getHash _accountStakeCooldown
+            }
+
 instance (IsAccountVersion av) => HashableTo (AccountHash av) (Account av) where
     getHash acc = makeAccountHash $ case accountVersion @av of
         SAccountV0 -> AHIV0 (accountHashInputsV0 acc)
         SAccountV1 -> AHIV1 (accountHashInputsV0 acc)
         SAccountV2 -> AHIV2 (accountHashInputsV2 acc)
+        SAccountV3 -> AHIV3 (accountHashInputsV3 acc)
 
 instance forall av. (IsAccountVersion av) => HashableTo Hash.Hash (Account av) where
     getHash = coerce @(AccountHash av) . getHash
@@ -163,7 +191,8 @@ newAccountMultiCredential cryptoParams threshold _accountAddress cs =
           _accountAmount = 0,
           _accountEncryptedAmount = initialAccountEncryptedAmount,
           _accountReleaseSchedule = emptyAccountReleaseSchedule,
-          _accountStaking = AccountStakeNone
+          _accountStaking = AccountStakeNone,
+          _accountStakeCooldown = emptyCooldownQueue
         }
 
 -- | Create an empty account with the given public key, address and credential.
diff --git a/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/AccountReleaseSchedule.hs b/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/AccountReleaseSchedule.hs
index e2766703c..81999aca3 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/AccountReleaseSchedule.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/AccountReleaseSchedule.hs
@@ -25,6 +25,7 @@ type family AccountReleaseSchedule' (av :: AccountVersion) where
     AccountReleaseSchedule' 'AccountV0 = ARSV0.AccountReleaseSchedule
     AccountReleaseSchedule' 'AccountV1 = ARSV0.AccountReleaseSchedule
     AccountReleaseSchedule' 'AccountV2 = ARSV1.AccountReleaseSchedule
+    AccountReleaseSchedule' 'AccountV3 = ARSV1.AccountReleaseSchedule
 
 -- | Release schedule on an account, parametrized by the account version.
 newtype AccountReleaseSchedule (av :: AccountVersion) = AccountReleaseSchedule
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs
index ca9728b27..96575c1f0 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs
@@ -40,25 +40,30 @@ data PersistentAccount (av :: AccountVersion) where
     PAV0 :: !(V0.PersistentAccount 'AccountV0) -> PersistentAccount 'AccountV0
     PAV1 :: !(V0.PersistentAccount 'AccountV1) -> PersistentAccount 'AccountV1
     PAV2 :: !(V1.PersistentAccount 'AccountV2) -> PersistentAccount 'AccountV2
+    PAV3 :: !(V1.PersistentAccount 'AccountV3) -> PersistentAccount 'AccountV3
 
 instance (MonadBlobStore m) => MHashableTo m (AccountHash av) (PersistentAccount av) where
     getHashM (PAV0 acc) = getHashM acc
     getHashM (PAV1 acc) = getHashM acc
     getHashM (PAV2 acc) = getHashM acc
+    getHashM (PAV3 acc) = getHashM acc
 
 instance (MonadBlobStore m) => MHashableTo m Hash.Hash (PersistentAccount av) where
     getHashM (PAV0 acc) = getHashM acc
     getHashM (PAV1 acc) = getHashM acc
     getHashM (PAV2 acc) = getHashM acc
+    getHashM (PAV3 acc) = getHashM acc
 
 instance (IsAccountVersion av, MonadBlobStore m) => BlobStorable m (PersistentAccount av) where
     storeUpdate (PAV0 acct) = second PAV0 <$!> storeUpdate acct
     storeUpdate (PAV1 acct) = second PAV1 <$!> storeUpdate acct
     storeUpdate (PAV2 acct) = second PAV2 <$!> storeUpdate acct
+    storeUpdate (PAV3 acct) = second PAV3 <$!> storeUpdate acct
     load = case accountVersion @av of
         SAccountV0 -> fmap PAV0 <$> load
         SAccountV1 -> fmap PAV1 <$> load
         SAccountV2 -> fmap PAV2 <$> load
+        SAccountV3 -> fmap PAV3 <$> load
 
 -- | Type of references to persistent accounts.
 type AccountRef (av :: AccountVersion) = HashedCachedRef (AccountCache av) (PersistentAccount av)
@@ -68,20 +73,24 @@ data PersistentBakerInfoRef (av :: AccountVersion) where
     PBIRV0 :: !(V0.PersistentBakerInfoEx 'AccountV0) -> PersistentBakerInfoRef 'AccountV0
     PBIRV1 :: !(V0.PersistentBakerInfoEx 'AccountV1) -> PersistentBakerInfoRef 'AccountV1
     PBIRV2 :: !(V1.PersistentBakerInfoEx 'AccountV2) -> PersistentBakerInfoRef 'AccountV2
+    PBIRV3 :: !(V1.PersistentBakerInfoEx 'AccountV3) -> PersistentBakerInfoRef 'AccountV3
 
 instance Show (PersistentBakerInfoRef av) where
     show (PBIRV0 pibr) = show pibr
     show (PBIRV1 pibr) = show pibr
     show (PBIRV2 pibr) = show pibr
+    show (PBIRV3 pibr) = show pibr
 
 instance (IsAccountVersion av, MonadBlobStore m) => BlobStorable m (PersistentBakerInfoRef av) where
     storeUpdate (PBIRV0 bir) = second PBIRV0 <$!> storeUpdate bir
     storeUpdate (PBIRV1 bir) = second PBIRV1 <$!> storeUpdate bir
     storeUpdate (PBIRV2 bir) = second PBIRV2 <$!> storeUpdate bir
+    storeUpdate (PBIRV3 bir) = second PBIRV3 <$!> storeUpdate bir
     load = case accountVersion @av of
         SAccountV0 -> fmap PBIRV0 <$!> load
         SAccountV1 -> fmap PBIRV1 <$!> load
         SAccountV2 -> fmap PBIRV2 <$!> load
+        SAccountV3 -> fmap PBIRV3 <$!> load
 
 -- * Account cache
 
@@ -99,30 +108,35 @@ accountCanonicalAddress :: (MonadBlobStore m) => PersistentAccount av -> m Accou
 accountCanonicalAddress (PAV0 acc) = V0.getCanonicalAddress acc
 accountCanonicalAddress (PAV1 acc) = V0.getCanonicalAddress acc
 accountCanonicalAddress (PAV2 acc) = V1.getCanonicalAddress acc
+accountCanonicalAddress (PAV3 acc) = V1.getCanonicalAddress acc
 
 -- | Get the current public account balance.
 accountAmount :: (MonadBlobStore m) => PersistentAccount av -> m Amount
 accountAmount (PAV0 acc) = V0.getAmount acc
 accountAmount (PAV1 acc) = V0.getAmount acc
 accountAmount (PAV2 acc) = V1.getAmount acc
+accountAmount (PAV3 acc) = V1.getAmount acc
 
 -- | Gets the amount of a baker's stake, or 'Nothing' if the account is not a baker.
 accountBakerStakeAmount :: (MonadBlobStore m) => PersistentAccount av -> m (Maybe Amount)
 accountBakerStakeAmount (PAV0 acc) = V0.getBakerStakeAmount acc
 accountBakerStakeAmount (PAV1 acc) = V0.getBakerStakeAmount acc
 accountBakerStakeAmount (PAV2 acc) = V1.getBakerStakeAmount acc
+accountBakerStakeAmount (PAV3 acc) = V1.getBakerStakeAmount acc
 
 -- | Get the amount that is staked on the account.
 accountStakedAmount :: (MonadBlobStore m) => PersistentAccount av -> m Amount
 accountStakedAmount (PAV0 acc) = V0.getStakedAmount acc
 accountStakedAmount (PAV1 acc) = V0.getStakedAmount acc
 accountStakedAmount (PAV2 acc) = V1.getStakedAmount acc
+accountStakedAmount (PAV3 acc) = V1.getStakedAmount acc
 
 -- | Get the amount that is locked in scheduled releases on the account.
 accountLockedAmount :: (MonadBlobStore m) => PersistentAccount av -> m Amount
 accountLockedAmount (PAV0 acc) = V0.getLockedAmount acc
 accountLockedAmount (PAV1 acc) = V0.getLockedAmount acc
 accountLockedAmount (PAV2 acc) = V1.getLockedAmount acc
+accountLockedAmount (PAV3 acc) = V1.getLockedAmount acc
 
 -- | Get the current public account available balance.
 -- This accounts for lock-up and staked amounts.
@@ -131,12 +145,14 @@ accountAvailableAmount :: (MonadBlobStore m) => PersistentAccount av -> m Amount
 accountAvailableAmount (PAV0 acc) = V0.getAvailableAmount acc
 accountAvailableAmount (PAV1 acc) = V0.getAvailableAmount acc
 accountAvailableAmount (PAV2 acc) = V1.getAvailableAmount acc
+accountAvailableAmount (PAV3 acc) = V1.getAvailableAmount acc
 
 -- | Get the next account nonce for transactions from this account.
 accountNonce :: (MonadBlobStore m) => PersistentAccount av -> m Nonce
 accountNonce (PAV0 acc) = V0.getNonce acc
 accountNonce (PAV1 acc) = V0.getNonce acc
 accountNonce (PAV2 acc) = V1.getNonce acc
+accountNonce (PAV3 acc) = V1.getNonce acc
 
 -- | Determine if a given operation is permitted for the account.
 --
@@ -147,6 +163,7 @@ accountIsAllowed :: (MonadBlobStore m) => PersistentAccount av -> AccountAllowan
 accountIsAllowed (PAV0 acc) = V0.isAllowed acc
 accountIsAllowed (PAV1 acc) = V0.isAllowed acc
 accountIsAllowed (PAV2 acc) = V1.isAllowed acc
+accountIsAllowed (PAV3 acc) = V1.isAllowed acc
 
 -- | Get the credentials deployed on the account. This map is always non-empty and (presently)
 --  will have a credential at index 'initialCredentialIndex' (0) that cannot be changed.
@@ -154,84 +171,98 @@ accountCredentials :: (MonadBlobStore m) => PersistentAccount av -> m (Map.Map C
 accountCredentials (PAV0 acc) = V0.getCredentials acc
 accountCredentials (PAV1 acc) = V0.getCredentials acc
 accountCredentials (PAV2 acc) = V1.getCredentials acc
+accountCredentials (PAV3 acc) = V1.getCredentials acc
 
 -- | Get the key used to verify transaction signatures, it records the signature scheme used as well.
 accountVerificationKeys :: (MonadBlobStore m) => PersistentAccount av -> m AccountInformation
 accountVerificationKeys (PAV0 acc) = V0.getVerificationKeys acc
 accountVerificationKeys (PAV1 acc) = V0.getVerificationKeys acc
 accountVerificationKeys (PAV2 acc) = V1.getVerificationKeys acc
+accountVerificationKeys (PAV3 acc) = V1.getVerificationKeys acc
 
 -- | Get the current encrypted amount on the account.
 accountEncryptedAmount :: (MonadBlobStore m) => PersistentAccount av -> m AccountEncryptedAmount
 accountEncryptedAmount (PAV0 acc) = V0.getEncryptedAmount acc
 accountEncryptedAmount (PAV1 acc) = V0.getEncryptedAmount acc
 accountEncryptedAmount (PAV2 acc) = V1.getEncryptedAmount acc
+accountEncryptedAmount (PAV3 acc) = V1.getEncryptedAmount acc
 
 -- | Get the public key used to receive encrypted amounts.
 accountEncryptionKey :: (MonadBlobStore m) => PersistentAccount av -> m AccountEncryptionKey
 accountEncryptionKey (PAV0 acc) = V0.getEncryptionKey acc
 accountEncryptionKey (PAV1 acc) = V0.getEncryptionKey acc
 accountEncryptionKey (PAV2 acc) = V1.getEncryptionKey acc
+accountEncryptionKey (PAV3 acc) = V1.getEncryptionKey acc
 
 -- | Get the 'AccountReleaseSummary' summarising scheduled releases for an account.
 accountReleaseSummary :: (MonadBlobStore m) => PersistentAccount av -> m AccountReleaseSummary
 accountReleaseSummary (PAV0 acc) = V0.getReleaseSummary acc
 accountReleaseSummary (PAV1 acc) = V0.getReleaseSummary acc
 accountReleaseSummary (PAV2 acc) = V1.getReleaseSummary acc
+accountReleaseSummary (PAV3 acc) = V1.getReleaseSummary acc
 
 -- | Get the timestamp at which the next scheduled release will occur (if any).
 accountNextReleaseTimestamp :: (MonadBlobStore m) => PersistentAccount av -> m (Maybe Timestamp)
 accountNextReleaseTimestamp (PAV0 acc) = V0.getNextReleaseTimestamp acc
 accountNextReleaseTimestamp (PAV1 acc) = V0.getNextReleaseTimestamp acc
 accountNextReleaseTimestamp (PAV2 acc) = V1.getNextReleaseTimestamp acc
+accountNextReleaseTimestamp (PAV3 acc) = V1.getNextReleaseTimestamp acc
 
 -- | Get the baker (if any) attached to an account.
 accountBaker :: (MonadBlobStore m) => PersistentAccount av -> m (Maybe (AccountBaker av))
 accountBaker (PAV0 acc) = V0.getBaker acc
 accountBaker (PAV1 acc) = V0.getBaker acc
 accountBaker (PAV2 acc) = V1.getBaker acc
+accountBaker (PAV3 acc) = V1.getBaker acc
 
 -- | Get a reference to the baker info (if any) attached to an account.
 accountBakerInfoRef :: (MonadBlobStore m) => PersistentAccount av -> m (Maybe (PersistentBakerInfoRef av))
 accountBakerInfoRef (PAV0 acc) = fmap PBIRV0 <$> V0.getBakerInfoRef acc
 accountBakerInfoRef (PAV1 acc) = fmap PBIRV1 <$> V0.getBakerInfoRef acc
 accountBakerInfoRef (PAV2 acc) = fmap PBIRV2 <$> V1.getBakerInfoRef acc
+accountBakerInfoRef (PAV3 acc) = fmap PBIRV3 <$> V1.getBakerInfoRef acc
 
 -- | Get the baker and baker info reference (if any) attached to the account.
 accountBakerAndInfoRef :: (MonadBlobStore m) => PersistentAccount av -> m (Maybe (AccountBaker av, PersistentBakerInfoRef av))
 accountBakerAndInfoRef (PAV0 acc) = fmap (second PBIRV0) <$> V0.getBakerAndInfoRef acc
 accountBakerAndInfoRef (PAV1 acc) = fmap (second PBIRV1) <$> V0.getBakerAndInfoRef acc
 accountBakerAndInfoRef (PAV2 acc) = fmap (second PBIRV2) <$> V1.getBakerAndInfoRef acc
+accountBakerAndInfoRef (PAV3 acc) = fmap (second PBIRV3) <$> V1.getBakerAndInfoRef acc
 
 -- | Get the delegator (if any) attached to the account.
 accountDelegator :: (MonadBlobStore m) => PersistentAccount av -> m (Maybe (AccountDelegation av))
 accountDelegator (PAV0 acc) = V0.getDelegator acc
 accountDelegator (PAV1 acc) = V0.getDelegator acc
 accountDelegator (PAV2 acc) = V1.getDelegator acc
+accountDelegator (PAV3 acc) = V1.getDelegator acc
 
 -- | Get the baker or stake delegation information attached to an account.
 accountStake :: (MonadBlobStore m) => PersistentAccount av -> m (AccountStake av)
 accountStake (PAV0 acc) = V0.getStake acc
 accountStake (PAV1 acc) = V0.getStake acc
 accountStake (PAV2 acc) = V1.getStake acc
+accountStake (PAV3 acc) = V1.getStake acc
 
 -- | Determine if an account has stake as a baker or delegator.
 accountHasStake :: PersistentAccount av -> Bool
 accountHasStake (PAV0 acc) = V0.hasStake acc
 accountHasStake (PAV1 acc) = V0.hasStake acc
 accountHasStake (PAV2 acc) = V1.hasStake acc
+accountHasStake (PAV3 acc) = V1.hasStake acc
 
 -- | Get details about an account's stake.
 accountStakeDetails :: (MonadBlobStore m) => PersistentAccount av -> m (StakeDetails av)
 accountStakeDetails (PAV0 acc) = V0.getStakeDetails acc
 accountStakeDetails (PAV1 acc) = V0.getStakeDetails acc
 accountStakeDetails (PAV2 acc) = V1.getStakeDetails acc
+accountStakeDetails (PAV3 acc) = V1.getStakeDetails acc
 
 -- | Get the 'AccountHash' for the account.
 accountHash :: (MonadBlobStore m) => PersistentAccount av -> m (AccountHash av)
 accountHash (PAV0 acc) = getHashM acc
 accountHash (PAV1 acc) = getHashM acc
 accountHash (PAV2 acc) = getHashM acc
+accountHash (PAV3 acc) = getHashM acc
 
 -- ** 'PersistentBakerInfoRef' queries
 
@@ -240,18 +271,21 @@ loadBakerInfo :: (MonadBlobStore m) => PersistentBakerInfoRef av -> m BakerInfo
 loadBakerInfo (PBIRV0 bir) = V0.loadBakerInfo bir
 loadBakerInfo (PBIRV1 bir) = V0.loadBakerInfo bir
 loadBakerInfo (PBIRV2 bir) = V1.loadBakerInfo bir
+loadBakerInfo (PBIRV3 bir) = V1.loadBakerInfo bir
 
 -- | Load 'BakerInfoEx' from a 'PersistentBakerInfoRef'.
 loadPersistentBakerInfoRef :: (MonadBlobStore m) => PersistentBakerInfoRef av -> m (BakerInfoEx av)
 loadPersistentBakerInfoRef (PBIRV0 bir) = V0.loadPersistentBakerInfoEx bir
 loadPersistentBakerInfoRef (PBIRV1 bir) = V0.loadPersistentBakerInfoEx bir
 loadPersistentBakerInfoRef (PBIRV2 bir) = V1.loadPersistentBakerInfoEx bir
+loadPersistentBakerInfoRef (PBIRV3 bir) = V1.loadPersistentBakerInfoEx bir
 
 -- | Load the 'BakerId' from a 'PersistentBakerInfoRef'.
 loadBakerId :: (MonadBlobStore m) => PersistentBakerInfoRef av -> m BakerId
 loadBakerId (PBIRV0 bir) = V0.loadBakerId bir
 loadBakerId (PBIRV1 bir) = V0.loadBakerId bir
 loadBakerId (PBIRV2 bir) = V1.loadBakerId bir
+loadBakerId (PBIRV3 bir) = V1.loadBakerId bir
 
 -- * Updates
 
@@ -260,6 +294,7 @@ updateAccount :: (MonadBlobStore m) => AccountUpdate -> PersistentAccount av ->
 updateAccount upd (PAV0 acc) = PAV0 <$> V0.updateAccount upd acc
 updateAccount upd (PAV1 acc) = PAV1 <$> V0.updateAccount upd acc
 updateAccount upd (PAV2 acc) = PAV2 <$> V1.updateAccount upd acc
+updateAccount upd (PAV3 acc) = PAV3 <$> V1.updateAccount upd acc
 
 -- | Add or remove credentials on an account.
 --  The caller must ensure the following, which are not checked:
@@ -286,6 +321,8 @@ updateAccountCredentials cuRemove cuAdd cuAccountThreshold (PAV1 acc) =
     PAV1 <$> V0.updateAccountCredentials cuRemove cuAdd cuAccountThreshold acc
 updateAccountCredentials cuRemove cuAdd cuAccountThreshold (PAV2 acc) =
     PAV2 <$> V1.updateAccountCredentials cuRemove cuAdd cuAccountThreshold acc
+updateAccountCredentials cuRemove cuAdd cuAccountThreshold (PAV3 acc) =
+    PAV3 <$> V1.updateAccountCredentials cuRemove cuAdd cuAccountThreshold acc
 
 -- | Optionally update the verification keys and signature threshold for an account.
 --  Precondition: The credential with given credential index exists.
@@ -304,12 +341,15 @@ updateAccountCredentialKeys credIndex credKeys (PAV1 acc) =
     PAV1 <$> V0.updateAccountCredentialKeys credIndex credKeys acc
 updateAccountCredentialKeys credIndex credKeys (PAV2 acc) =
     PAV2 <$> V1.updateAccountCredentialKeys credIndex credKeys acc
+updateAccountCredentialKeys credIndex credKeys (PAV3 acc) =
+    PAV3 <$> V1.updateAccountCredentialKeys credIndex credKeys acc
 
 -- | Add an amount to the account's balance.
 addAccountAmount :: (MonadBlobStore m) => Amount -> PersistentAccount av -> m (PersistentAccount av)
 addAccountAmount amt (PAV0 acc) = PAV0 <$> V0.addAmount amt acc
 addAccountAmount amt (PAV1 acc) = PAV1 <$> V0.addAmount amt acc
 addAccountAmount amt (PAV2 acc) = PAV2 <$> V1.addAmount amt acc
+addAccountAmount amt (PAV3 acc) = PAV3 <$> V1.addAmount amt acc
 
 -- | Applies a pending stake change to an account. The account MUST have a pending stake change.
 --  If the account does not have a pending stake change, or is not staking, then this will raise
@@ -337,6 +377,7 @@ addAccountBakerV1 ::
     m (PersistentAccount av)
 addAccountBakerV1 binfo amt restake (PAV1 acc) = PAV1 <$> V0.addBakerV1 binfo amt restake acc
 addAccountBakerV1 binfo amt restake (PAV2 acc) = PAV2 <$> V1.addBakerV1 binfo amt restake acc
+addAccountBakerV1 binfo amt restake (PAV3 acc) = PAV3 <$> V1.addBakerV1 binfo amt restake acc
 
 -- | Add a delegator to an account.
 --  This will replace any existing staking information on the account.
@@ -347,6 +388,7 @@ addAccountDelegator ::
     m (PersistentAccount av)
 addAccountDelegator del (PAV1 acc) = PAV1 <$> V0.addDelegator del acc
 addAccountDelegator del (PAV2 acc) = PAV2 <$> V1.addDelegator del acc
+addAccountDelegator del (PAV3 acc) = PAV3 <$> V1.addDelegator del acc
 
 -- | Update the pool info on a baker account.
 --  This MUST only be called with an account that is a baker.
@@ -357,6 +399,7 @@ updateAccountBakerPoolInfo ::
     m (PersistentAccount av)
 updateAccountBakerPoolInfo upd (PAV1 acc) = PAV1 <$> V0.updateBakerPoolInfo upd acc
 updateAccountBakerPoolInfo upd (PAV2 acc) = PAV2 <$> V1.updateBakerPoolInfo upd acc
+updateAccountBakerPoolInfo upd (PAV3 acc) = PAV3 <$> V1.updateBakerPoolInfo upd acc
 
 -- | Set the baker keys on a baker account.
 --  This MUST only be called with an account that is a baker.
@@ -368,6 +411,7 @@ setAccountBakerKeys ::
 setAccountBakerKeys keys (PAV0 acc) = PAV0 <$> V0.setBakerKeys keys acc
 setAccountBakerKeys keys (PAV1 acc) = PAV1 <$> V0.setBakerKeys keys acc
 setAccountBakerKeys keys (PAV2 acc) = PAV2 <$> V1.setBakerKeys keys acc
+setAccountBakerKeys keys (PAV3 acc) = PAV3 <$> V1.setBakerKeys keys acc
 
 -- | Set the stake of a baker or delegator account.
 --  This MUST only be called with an account that is either a baker or delegator.
@@ -380,6 +424,7 @@ setAccountStake ::
 setAccountStake newStake (PAV0 acc) = PAV0 <$> V0.setStake newStake acc
 setAccountStake newStake (PAV1 acc) = PAV1 <$> V0.setStake newStake acc
 setAccountStake newStake (PAV2 acc) = PAV2 <$> V1.setStake newStake acc
+setAccountStake newStake (PAV3 acc) = PAV3 <$> V1.setStake newStake acc
 
 -- | Set whether a baker or delegator account restakes its earnings.
 --  This MUST only be called with an account that is either a baker or delegator.
@@ -391,6 +436,7 @@ setAccountRestakeEarnings ::
 setAccountRestakeEarnings restake (PAV0 acc) = PAV0 <$> V0.setRestakeEarnings restake acc
 setAccountRestakeEarnings restake (PAV1 acc) = PAV1 <$> V0.setRestakeEarnings restake acc
 setAccountRestakeEarnings restake (PAV2 acc) = PAV2 <$> V1.setRestakeEarnings restake acc
+setAccountRestakeEarnings restake (PAV3 acc) = PAV3 <$> V1.setRestakeEarnings restake acc
 
 -- | Set the pending change on baker or delegator account.
 --  This MUST only be called with an account that is either a baker or delegator.
@@ -402,6 +448,7 @@ setAccountStakePendingChange ::
 setAccountStakePendingChange pc (PAV0 acc) = PAV0 <$> V0.setStakePendingChange pc acc
 setAccountStakePendingChange pc (PAV1 acc) = PAV1 <$> V0.setStakePendingChange pc acc
 setAccountStakePendingChange pc (PAV2 acc) = PAV2 <$> V1.setStakePendingChange pc acc
+setAccountStakePendingChange pc (PAV3 acc) = PAV3 <$> V1.setStakePendingChange pc acc
 
 -- | Set the target of a delegating account.
 --  This MUST only be called with an account that is a delegator.
@@ -413,6 +460,7 @@ setAccountDelegationTarget ::
 setAccountDelegationTarget target (PAV0 acc) = PAV0 <$> V0.setDelegationTarget target acc
 setAccountDelegationTarget target (PAV1 acc) = PAV1 <$> V0.setDelegationTarget target acc
 setAccountDelegationTarget target (PAV2 acc) = PAV2 <$> V1.setDelegationTarget target acc
+setAccountDelegationTarget target (PAV3 acc) = PAV3 <$> V1.setDelegationTarget target acc
 
 -- | Remove any staking on an account.
 removeAccountStaking ::
@@ -422,6 +470,7 @@ removeAccountStaking ::
 removeAccountStaking (PAV0 acc) = PAV0 <$> V0.removeStaking acc
 removeAccountStaking (PAV1 acc) = PAV1 <$> V0.removeStaking acc
 removeAccountStaking (PAV2 acc) = PAV2 <$> V1.removeStaking acc
+removeAccountStaking (PAV3 acc) = PAV3 <$> V1.removeStaking acc
 
 -- | Set the commission rates on a baker account.
 --  This MUST only be called with an account that is a baker.
@@ -432,6 +481,7 @@ setAccountCommissionRates ::
     m (PersistentAccount av)
 setAccountCommissionRates rates (PAV1 acc) = PAV1 <$> V0.setCommissionRates rates acc
 setAccountCommissionRates rates (PAV2 acc) = PAV2 <$> V1.setCommissionRates rates acc
+setAccountCommissionRates rates (PAV3 acc) = PAV3 <$> V1.setCommissionRates rates acc
 
 -- | Unlock scheduled releases on an account up to and including the given timestamp.
 --  This returns the next timestamp at which a release is scheduled for the account, if any,
@@ -444,6 +494,7 @@ unlockAccountReleases ::
 unlockAccountReleases ts (PAV0 acc) = second PAV0 <$> V0.unlockReleases ts acc
 unlockAccountReleases ts (PAV1 acc) = second PAV1 <$> V0.unlockReleases ts acc
 unlockAccountReleases ts (PAV2 acc) = second PAV2 <$> V1.unlockReleases ts acc
+unlockAccountReleases ts (PAV3 acc) = second PAV3 <$> V1.unlockReleases ts acc
 
 -- * Creation
 
@@ -457,6 +508,7 @@ makePersistentAccount tacc = case accountVersion @av of
     SAccountV0 -> PAV0 <$> V0.makePersistentAccount tacc
     SAccountV1 -> PAV1 <$> V0.makePersistentAccount tacc
     SAccountV2 -> PAV2 <$> V1.makePersistentAccount tacc
+    SAccountV3 -> PAV3 <$> V1.makePersistentAccount tacc
 
 -- | Create an empty account with the given public key, address and credential.
 newAccount ::
@@ -470,6 +522,7 @@ newAccount = case accountVersion @av of
     SAccountV0 -> \ctx addr cred -> PAV0 <$> V0.newAccount ctx addr cred
     SAccountV1 -> \ctx addr cred -> PAV1 <$> V0.newAccount ctx addr cred
     SAccountV2 -> \ctx addr cred -> PAV2 <$> V1.newAccount ctx addr cred
+    SAccountV3 -> \ctx addr cred -> PAV3 <$> V1.newAccount ctx addr cred
 
 -- | Make a persistent account from a genesis account.
 --  The data is immediately flushed to disc and cached.
@@ -489,6 +542,8 @@ makeFromGenesisAccount spv =
             PAV1 <$> V0.makeFromGenesisAccount spv cryptoParams chainParameters genesisAccount
         SAccountV2 -> \cryptoParams chainParameters genesisAccount ->
             PAV2 <$> V1.makeFromGenesisAccount spv cryptoParams chainParameters genesisAccount
+        SAccountV3 -> \cryptoParams chainParameters genesisAccount ->
+            PAV3 <$> V1.makeFromGenesisAccount spv cryptoParams chainParameters genesisAccount
 
 -- ** 'PersistentBakerInfoRef' creation
 
@@ -502,6 +557,7 @@ makePersistentBakerInfoRef = case accountVersion @av of
     SAccountV0 -> fmap PBIRV0 . V0.makePersistentBakerInfoEx
     SAccountV1 -> fmap PBIRV1 . V0.makePersistentBakerInfoEx
     SAccountV2 -> fmap PBIRV2 . V1.makePersistentBakerInfoEx
+    SAccountV3 -> fmap PBIRV3 . V1.makePersistentBakerInfoEx
 
 -- * Migration
 
@@ -518,12 +574,13 @@ migratePersistentAccount ::
 migratePersistentAccount m@StateMigrationParametersTrivial (PAV0 acc) = PAV0 <$> V0.migratePersistentAccount m acc
 migratePersistentAccount m@StateMigrationParametersTrivial (PAV1 acc) = PAV1 <$> V0.migratePersistentAccount m acc
 migratePersistentAccount m@StateMigrationParametersTrivial (PAV2 acc) = PAV2 <$> V1.migratePersistentAccount m acc
+migratePersistentAccount m@StateMigrationParametersTrivial (PAV3 acc) = PAV3 <$> V1.migratePersistentAccount m acc
 migratePersistentAccount m@StateMigrationParametersP1P2 (PAV0 acc) = PAV0 <$> V0.migratePersistentAccount m acc
 migratePersistentAccount m@StateMigrationParametersP2P3 (PAV0 acc) = PAV0 <$> V0.migratePersistentAccount m acc
 migratePersistentAccount m@StateMigrationParametersP3ToP4{} (PAV0 acc) = PAV1 <$> V0.migratePersistentAccount m acc
 migratePersistentAccount m@StateMigrationParametersP4ToP5{} (PAV1 acc) = PAV2 <$> V1.migratePersistentAccountFromV0 m acc
 migratePersistentAccount m@StateMigrationParametersP5ToP6{} (PAV2 acc) = PAV2 <$> V1.migratePersistentAccount m acc
-migratePersistentAccount m@StateMigrationParametersP6ToP7{} (PAV2 acc) = PAV2 <$> V1.migratePersistentAccount m acc
+migratePersistentAccount m@StateMigrationParametersP6ToP7{} (PAV2 acc) = PAV3 <$> V1.migratePersistentAccount m acc
 
 -- | Migrate a 'PersistentBakerInfoRef' between protocol versions according to a state migration.
 migratePersistentBakerInfoRef ::
@@ -532,15 +589,16 @@ migratePersistentBakerInfoRef ::
     StateMigrationParameters oldpv pv ->
     PersistentBakerInfoRef (AccountVersionFor oldpv) ->
     t m (PersistentBakerInfoRef (AccountVersionFor pv))
+migratePersistentBakerInfoRef m@StateMigrationParametersTrivial (PBIRV0 bir) = PBIRV0 <$> V0.migratePersistentBakerInfoEx m bir
 migratePersistentBakerInfoRef m@StateMigrationParametersTrivial (PBIRV1 bir) = PBIRV1 <$> V0.migratePersistentBakerInfoEx m bir
 migratePersistentBakerInfoRef m@StateMigrationParametersTrivial (PBIRV2 bir) = PBIRV2 <$> V1.migratePersistentBakerInfoEx m bir
-migratePersistentBakerInfoRef m@StateMigrationParametersTrivial (PBIRV0 bir) = PBIRV0 <$> V0.migratePersistentBakerInfoEx m bir
+migratePersistentBakerInfoRef m@StateMigrationParametersTrivial (PBIRV3 bir) = PBIRV3 <$> V1.migratePersistentBakerInfoEx m bir
 migratePersistentBakerInfoRef m@StateMigrationParametersP1P2 (PBIRV0 bir) = PBIRV0 <$> V0.migratePersistentBakerInfoEx m bir
 migratePersistentBakerInfoRef m@StateMigrationParametersP2P3 (PBIRV0 bir) = PBIRV0 <$> V0.migratePersistentBakerInfoEx m bir
 migratePersistentBakerInfoRef m@StateMigrationParametersP3ToP4{} (PBIRV0 bir) = PBIRV1 <$> V0.migratePersistentBakerInfoEx m bir
 migratePersistentBakerInfoRef m@StateMigrationParametersP4ToP5{} (PBIRV1 bir) = PBIRV2 <$> V1.migratePersistentBakerInfoExFromV0 m bir
 migratePersistentBakerInfoRef m@StateMigrationParametersP5ToP6{} (PBIRV2 bir) = PBIRV2 <$> V1.migratePersistentBakerInfoEx m bir
-migratePersistentBakerInfoRef m@StateMigrationParametersP6ToP7{} (PBIRV2 bir) = PBIRV2 <$> V1.migratePersistentBakerInfoEx m bir
+migratePersistentBakerInfoRef m@StateMigrationParametersP6ToP7{} (PBIRV2 bir) = PBIRV3 <$> V1.migratePersistentBakerInfoEx m bir
 
 -- * Conversion
 
@@ -549,3 +607,4 @@ toTransientAccount :: (MonadBlobStore m) => PersistentAccount av -> m (Transient
 toTransientAccount (PAV0 acc) = V0.toTransientAccount acc
 toTransientAccount (PAV1 acc) = V0.toTransientAccount acc
 toTransientAccount (PAV2 acc) = V1.toTransientAccount acc
+toTransientAccount (PAV3 acc) = V1.toTransientAccount acc
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV0.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV0.hs
index d21a27daf..a04bdc7b9 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV0.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV0.hs
@@ -49,6 +49,7 @@ import Concordium.GlobalState.Persistent.Account.EncryptedAmount
 import Concordium.GlobalState.Persistent.BlobStore
 import Concordium.GlobalState.Persistent.BlockState.AccountReleaseSchedule
 import Concordium.GlobalState.Persistent.CachedRef
+import Concordium.Types.Accounts.CooldownQueue
 
 -- * A note on 'Cacheable' instances for persistent accounts
 
@@ -1205,4 +1206,5 @@ toTransientAccount PersistentAccount{..} = do
         PersistentAccountStakeNone -> return AccountStakeNone
         PersistentAccountStakeBaker bkr -> AccountStakeBaker <$> (loadPersistentAccountBaker =<< refLoad bkr)
         PersistentAccountStakeDelegate dlg -> AccountStakeDelegate <$> refLoad dlg
+    let _accountStakeCooldown = emptyCooldownQueue
     return $ Transient.Account{..}
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
index 5ac177014..125be1261 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
@@ -44,6 +44,7 @@ import Concordium.GlobalState.Persistent.BlobStore
 import qualified Concordium.GlobalState.Persistent.BlockState.AccountReleaseSchedule as ARSV0
 import Concordium.GlobalState.Persistent.BlockState.AccountReleaseScheduleV1
 import Concordium.ID.Parameters
+import Concordium.Types.Accounts.CooldownQueue
 import Concordium.Types.Accounts.Releases
 import Control.Monad.Trans
 import qualified Data.Map.Strict as Map
@@ -96,7 +97,8 @@ makePersistentBakerInfoEx = refMake
 
 -- | See documentation of @migratePersistentBlockState@.
 migratePersistentBakerInfoEx ::
-    ( AccountVersionFor oldpv ~ 'AccountV2,
+    ( IsProtocolVersion oldpv,
+      AccountStructureVersionFor (AccountVersionFor oldpv) ~ 'AccountStructureV1,
       SupportMigration m t
     ) =>
     StateMigrationParameters oldpv pv ->
@@ -104,7 +106,13 @@ migratePersistentBakerInfoEx ::
     t m (PersistentBakerInfoEx (AccountVersionFor pv))
 migratePersistentBakerInfoEx StateMigrationParametersTrivial = migrateReference return
 migratePersistentBakerInfoEx StateMigrationParametersP5ToP6{} = migrateReference return
-migratePersistentBakerInfoEx StateMigrationParametersP6ToP7{} = migrateReference return
+migratePersistentBakerInfoEx StateMigrationParametersP6ToP7{} = migrateReference migrateBakerInfoExV1
+  where
+    migrateBakerInfoExV1 ::
+        (AVSupportsDelegation av1, AVSupportsDelegation av2, Monad m') =>
+        BakerInfoEx av1 ->
+        m' (BakerInfoEx av2)
+    migrateBakerInfoExV1 BakerInfoExV1{..} = return BakerInfoExV1{..}
 
 -- | Migrate a 'V0.PersistentBakerInfoEx' to a 'PersistentBakerInfoEx'.
 --  See documentation of @migratePersistentBlockState@.
@@ -137,14 +145,14 @@ data PersistentAccountStakeEnduring av where
     PersistentAccountStakeEnduringBaker ::
         { paseBakerRestakeEarnings :: !Bool,
           paseBakerInfo :: !(LazyBufferedRef (BakerInfoEx av)),
-          paseBakerPendingChange :: !(StakePendingChange' Timestamp)
+          paseBakerPendingChange :: !(StakePendingChange av)
         } ->
         PersistentAccountStakeEnduring av
     PersistentAccountStakeEnduringDelegator ::
         { paseDelegatorId :: !DelegatorId,
           paseDelegatorRestakeEarnings :: !Bool,
           paseDelegatorTarget :: !DelegationTarget,
-          paseDelegatorPendingChange :: !(StakePendingChange' Timestamp)
+          paseDelegatorPendingChange :: !(StakePendingChange av)
         } ->
         PersistentAccountStakeEnduring av
 
@@ -162,7 +170,7 @@ persistentToAccountStake PersistentAccountStakeEnduringBaker{..} _stakedAmount =
         AccountStakeBaker
             AccountBaker
                 { _stakeEarnings = paseBakerRestakeEarnings,
-                  _bakerPendingChange = PendingChangeEffectiveV1 <$> paseBakerPendingChange,
+                  _bakerPendingChange = paseBakerPendingChange,
                   ..
                 }
 persistentToAccountStake PersistentAccountStakeEnduringDelegator{..} _delegationStakedAmount = do
@@ -172,7 +180,7 @@ persistentToAccountStake PersistentAccountStakeEnduringDelegator{..} _delegation
                 { _delegationIdentity = paseDelegatorId,
                   _delegationStakeEarnings = paseDelegatorRestakeEarnings,
                   _delegationTarget = paseDelegatorTarget,
-                  _delegationPendingChange = PendingChangeEffectiveV1 <$> paseDelegatorPendingChange,
+                  _delegationPendingChange = paseDelegatorPendingChange,
                   ..
                 }
 
@@ -193,11 +201,31 @@ migratePersistentAccountStakeEnduring PersistentAccountStakeEnduringBaker{..} =
 migratePersistentAccountStakeEnduring PersistentAccountStakeEnduringDelegator{..} =
     return $! PersistentAccountStakeEnduringDelegator{..}
 
+migratePersistentAccountStakeEnduringV2toV3 ::
+    (SupportMigration m t) =>
+    PersistentAccountStakeEnduring 'AccountV2 ->
+    t m (PersistentAccountStakeEnduring 'AccountV3)
+migratePersistentAccountStakeEnduringV2toV3 PersistentAccountStakeEnduringNone =
+    return PersistentAccountStakeEnduringNone
+migratePersistentAccountStakeEnduringV2toV3 PersistentAccountStakeEnduringBaker{..} = do
+    newBakerInfo <- migrateReference (return . coerceBakerInfoEx) paseBakerInfo
+    return $!
+        PersistentAccountStakeEnduringBaker
+            { paseBakerInfo = newBakerInfo,
+              paseBakerPendingChange = NoChange,
+              ..
+            }
+migratePersistentAccountStakeEnduringV2toV3 PersistentAccountStakeEnduringDelegator{..} =
+    return $! PersistentAccountStakeEnduringDelegator{paseDelegatorPendingChange = NoChange, ..}
+
 -- | This relies on the fact that the 'AccountV2' hashing of 'AccountStake' is independent of the
 --  staked amount.
 instance (MonadBlobStore m) => MHashableTo m (AccountStakeHash 'AccountV2) (PersistentAccountStakeEnduring 'AccountV2) where
     getHashM stake = getHash <$> persistentToAccountStake stake 0
 
+instance (MonadBlobStore m) => MHashableTo m (AccountStakeHash 'AccountV3) (PersistentAccountStakeEnduring 'AccountV3) where
+    getHashM stake = getHash <$> persistentToAccountStake stake 0
+
 -- * Enduring account data
 
 -- | Enduring data associated with an account. This is data that does not change very often.
@@ -232,7 +260,9 @@ data PersistentAccountEnduringData (av :: AccountVersion) = PersistentAccountEnd
       --  it does not satisfy 'isEmptyAccountReleaseSchedule', and the amount will be the total of them.
       paedReleaseSchedule :: !(Nullable (LazyBufferedRef AccountReleaseSchedule, Amount)),
       -- | The staking details associated with the account.
-      paedStake :: !(PersistentAccountStakeEnduring av)
+      paedStake :: !(PersistentAccountStakeEnduring av),
+      -- | The cooldown.
+      paedStakeCooldown :: !(CooldownQueue av) -- FIXME: Figure out whether this should be a ref.
     }
 
 -- | Get the locked amount from a 'PersistingAccountEnduringData'.
@@ -251,7 +281,7 @@ instance HashableTo (AccountMerkleHash av) (PersistentAccountEnduringData av) wh
 --
 --  Precondition: if the 'AccountReleaseSchedule' is present, then it must have some releases
 --  and the total amount of the releases must be the provided amount.
-makeAccountEnduringData ::
+makeAccountEnduringDataAV2 ::
     ( MonadBlobStore m
     ) =>
     EagerBufferedRef PersistingAccountData ->
@@ -259,7 +289,7 @@ makeAccountEnduringData ::
     Nullable (LazyBufferedRef AccountReleaseSchedule, Amount) ->
     PersistentAccountStakeEnduring 'AccountV2 ->
     m (PersistentAccountEnduringData 'AccountV2)
-makeAccountEnduringData paedPersistingData paedEncryptedAmount paedReleaseSchedule paedStake = do
+makeAccountEnduringDataAV2 paedPersistingData paedEncryptedAmount paedReleaseSchedule paedStake = do
     amhi2PersistingAccountDataHash <- getHashM paedPersistingData
     (amhi2AccountStakeHash :: AccountStakeHash 'AccountV2) <- getHashM paedStake
     amhi2EncryptedAmountHash <- case paedEncryptedAmount of
@@ -271,11 +301,36 @@ makeAccountEnduringData paedPersistingData paedEncryptedAmount paedReleaseSchedu
     let hashInputs :: AccountMerkleHashInputs 'AccountV2
         hashInputs = AccountMerkleHashInputsV2{..}
         !paedHash = getHash hashInputs
+        paedStakeCooldown = emptyCooldownQueue
+    return $! PersistentAccountEnduringData{..}
+
+makeAccountEnduringDataAV3 ::
+    ( MonadBlobStore m
+    ) =>
+    EagerBufferedRef PersistingAccountData ->
+    Nullable (LazyBufferedRef PersistentAccountEncryptedAmount) ->
+    Nullable (LazyBufferedRef AccountReleaseSchedule, Amount) ->
+    PersistentAccountStakeEnduring 'AccountV3 ->
+    CooldownQueue 'AccountV3 ->
+    m (PersistentAccountEnduringData 'AccountV3)
+makeAccountEnduringDataAV3 paedPersistingData paedEncryptedAmount paedReleaseSchedule paedStake paedStakeCooldown = do
+    amhi3PersistingAccountDataHash <- getHashM paedPersistingData
+    (amhi3AccountStakeHash :: AccountStakeHash 'AccountV3) <- getHashM paedStake
+    amhi3EncryptedAmountHash <- case paedEncryptedAmount of
+        Null -> return initialAccountEncryptedAmountHash
+        Some e -> getHash <$> (loadPersistentAccountEncryptedAmount =<< refLoad e)
+    amhi3AccountReleaseScheduleHash <- case paedReleaseSchedule of
+        Null -> return TARSV1.emptyAccountReleaseScheduleHashV1
+        Some (rs, _) -> getHashM rs
+    let amhi3Cooldown = getHash paedStakeCooldown
+    let hashInputs :: AccountMerkleHashInputs 'AccountV3
+        hashInputs = AccountMerkleHashInputsV3{..}
+        !paedHash = getHash hashInputs
     return $! PersistentAccountEnduringData{..}
 
 -- | [For internal use in this module.] Recompute the Merkle hash of the enduring account data.
-rehashAccountEnduringData :: (MonadBlobStore m) => PersistentAccountEnduringData 'AccountV2 -> m (PersistentAccountEnduringData 'AccountV2)
-rehashAccountEnduringData ed = do
+rehashAccountEnduringDataAV2 :: (MonadBlobStore m) => PersistentAccountEnduringData 'AccountV2 -> m (PersistentAccountEnduringData 'AccountV2)
+rehashAccountEnduringDataAV2 ed = do
     amhi2PersistingAccountDataHash <- getHashM (paedPersistingData ed)
     (amhi2AccountStakeHash :: AccountStakeHash 'AccountV2) <- getHashM (paedStake ed)
     amhi2EncryptedAmountHash <- case paedEncryptedAmount ed of
@@ -288,12 +343,36 @@ rehashAccountEnduringData ed = do
         hashInputs = AccountMerkleHashInputsV2{..}
     return $! ed{paedHash = getHash hashInputs}
 
+rehashAccountEnduringDataAV3 :: (MonadBlobStore m) => PersistentAccountEnduringData 'AccountV3 -> m (PersistentAccountEnduringData 'AccountV3)
+rehashAccountEnduringDataAV3 ed = do
+    amhi3PersistingAccountDataHash <- getHashM (paedPersistingData ed)
+    (amhi3AccountStakeHash :: AccountStakeHash 'AccountV3) <- getHashM (paedStake ed)
+    amhi3EncryptedAmountHash <- case paedEncryptedAmount ed of
+        Null -> return initialAccountEncryptedAmountHash
+        Some e -> getHash <$> (loadPersistentAccountEncryptedAmount =<< refLoad e)
+    amhi3AccountReleaseScheduleHash <- case paedReleaseSchedule ed of
+        Null -> return TARSV1.emptyAccountReleaseScheduleHashV1
+        Some (rs, _) -> getHashM rs
+    let amhi3Cooldown = getHash $ paedStakeCooldown ed
+    let hashInputs :: AccountMerkleHashInputs 'AccountV3
+        hashInputs = AccountMerkleHashInputsV3{..}
+    return $! ed{paedHash = getHash hashInputs}
+
+rehashAccountEnduringData ::
+    forall m av.
+    (MonadBlobStore m, IsAccountVersion av, AccountStructureVersionFor av ~ 'AccountStructureV1) =>
+    PersistentAccountEnduringData av ->
+    m (PersistentAccountEnduringData av)
+rehashAccountEnduringData = case accountVersion @av of
+    SAccountV2 -> rehashAccountEnduringDataAV2
+    SAccountV3 -> rehashAccountEnduringDataAV3
+
 enduringDataFlags :: PersistentAccountEnduringData av -> EnduringDataFlags
 enduringDataFlags PersistentAccountEnduringData{..} =
     EnduringDataFlags
         { edHasEncryptedAmount = isNotNull paedEncryptedAmount,
           edHasReleaseSchedule = isNotNull paedReleaseSchedule,
-          edStakeFlags = stakeFlags paedStake
+          edStakeFlags = stakeFlags paedStake paedStakeCooldown
         }
 
 -- * Enduring account data storage helper definitions
@@ -317,10 +396,10 @@ data PendingChangeFlags
     deriving (Eq, Ord, Show)
 
 -- | Get the 'PendingChangeFlags' for a 'StakePendingChange''.
-stakePendingChangeFlags :: StakePendingChange' et -> PendingChangeFlags
-stakePendingChangeFlags NoChange = PendingChangeNone
-stakePendingChangeFlags ReduceStake{} = PendingChangeReduce
-stakePendingChangeFlags RemoveStake{} = PendingChangeRemove
+stakePendingChangeFlags :: StakePendingChange av -> CooldownQueue av -> PendingChangeFlags
+stakePendingChangeFlags NoChange queue = if isCooldownQueueEmpty queue then PendingChangeNone else PendingChangeReduce
+stakePendingChangeFlags ReduceStake{} _ = PendingChangeReduce
+stakePendingChangeFlags RemoveStake{} _ = PendingChangeRemove
 
 -- | Store a 'PendingChangeFlags' as the low-order 2 bits of a 'Word8'.
 pendingChangeFlagsToBits :: PendingChangeFlags -> Word8
@@ -362,6 +441,9 @@ pendingChangeFlagsFromBits _ = Left "Invalid pending change type"
 data StakeFlags
     = -- | The account is not staking
       StakeFlagsNone
+        { -- | Whether the stake is in cooldown
+          sfInCooldown :: !Bool
+        }
     | -- | The account is a baker
       StakeFlagsBaker
         { -- | Whether earnings are restaked
@@ -381,24 +463,26 @@ data StakeFlags
     deriving (Eq, Ord, Show)
 
 -- | Get the 'StakeFlags' from a 'PersistentAccountStakeEnduring'.
-stakeFlags :: PersistentAccountStakeEnduring av -> StakeFlags
-stakeFlags PersistentAccountStakeEnduringNone = StakeFlagsNone
-stakeFlags PersistentAccountStakeEnduringBaker{..} =
+stakeFlags :: PersistentAccountStakeEnduring av -> CooldownQueue av -> StakeFlags
+stakeFlags PersistentAccountStakeEnduringNone queue = StakeFlagsNone{sfInCooldown = isCooldownQueueEmpty queue}
+stakeFlags PersistentAccountStakeEnduringBaker{..} queue =
     StakeFlagsBaker
         { sfRestake = paseBakerRestakeEarnings,
-          sfChangeType = stakePendingChangeFlags paseBakerPendingChange
+          sfChangeType = stakePendingChangeFlags paseBakerPendingChange queue
         }
-stakeFlags PersistentAccountStakeEnduringDelegator{..} =
+stakeFlags PersistentAccountStakeEnduringDelegator{..} queue =
     StakeFlagsDelegator
         { sfPassive = DelegatePassive == paseDelegatorTarget,
           sfRestake = paseDelegatorRestakeEarnings,
-          sfChangeType = stakePendingChangeFlags paseDelegatorPendingChange
+          sfChangeType = stakePendingChangeFlags paseDelegatorPendingChange queue
         }
 
 -- | Store a 'StakeFlags' as the low-order 6 bits of a 'Word8'.
 stakeFlagsToBits :: StakeFlags -> Word8
-stakeFlagsToBits StakeFlagsNone =
+stakeFlagsToBits StakeFlagsNone{sfInCooldown = False} =
     0b00_0000
+stakeFlagsToBits StakeFlagsNone{sfInCooldown = True} =
+    0b00_0001
 stakeFlagsToBits StakeFlagsBaker{..} =
     0b01_0000
         .|. (if sfRestake then 0b00_0100 else 0b00_0000)
@@ -412,7 +496,8 @@ stakeFlagsToBits StakeFlagsDelegator{..} =
 -- | Load a 'StakeFlags' from the low-order 6 bits of a 'Word8'.
 --  All other bits must be 0.
 stakeFlagsFromBits :: Word8 -> Either String StakeFlags
-stakeFlagsFromBits 0b00_0000 = return StakeFlagsNone
+stakeFlagsFromBits 0b00_0000 = return StakeFlagsNone{sfInCooldown = False}
+stakeFlagsFromBits 0b00_0001 = return StakeFlagsNone{sfInCooldown = True}
 stakeFlagsFromBits bs = case bs .&. 0b11_0000 of
     0b01_0000 -> do
         when sfPassive $ Left "Passive bit cannot be set for baker"
@@ -540,7 +625,7 @@ instance (MonadBlobStore m, IsAccountVersion av) => BlobStorable m (PersistentAc
             getPC PendingChangeReduce = ReduceStake <$> get <*> get
             getPC PendingChangeRemove = RemoveStake <$> get
         mStake <- case edStakeFlags of
-            StakeFlagsNone -> return (return PersistentAccountStakeEnduringNone)
+            StakeFlagsNone{} -> return (return PersistentAccountStakeEnduringNone)
             StakeFlagsBaker{..} -> do
                 let paseBakerRestakeEarnings = sfRestake
                 mInfo <- load
@@ -559,6 +644,7 @@ instance (MonadBlobStore m, IsAccountVersion av) => BlobStorable m (PersistentAc
             paedEncryptedAmount <- mEncryptedAmount
             paedReleaseSchedule <- mReleaseSchedule
             paedStake <- mStake
+            let paedStakeCooldown = undefined
             return PersistentAccountEnduringData{..}
 
 -- * Persistent account
@@ -593,11 +679,29 @@ instance HashableTo (AccountHash 'AccountV2) (PersistentAccount 'AccountV2) wher
 
 instance (Monad m) => MHashableTo m (AccountHash 'AccountV2) (PersistentAccount 'AccountV2)
 
+instance HashableTo (AccountHash 'AccountV3) (PersistentAccount 'AccountV3) where
+    getHash PersistentAccount{..} =
+        makeAccountHash $
+            AHIV3 $
+                AccountHashInputsV2
+                    { ahi2NextNonce = accountNonce,
+                      ahi2AccountBalance = accountAmount,
+                      ahi2StakedBalance = accountStakedAmount,
+                      ahi2MerkleHash = getHash accountEnduringData
+                    }
+
+instance (Monad m) => MHashableTo m (AccountHash 'AccountV3) (PersistentAccount 'AccountV3)
+
 instance HashableTo Hash.Hash (PersistentAccount 'AccountV2) where
     getHash = theAccountHash @'AccountV2 . getHash
 
 instance (Monad m) => MHashableTo m Hash.Hash (PersistentAccount 'AccountV2)
 
+instance HashableTo Hash.Hash (PersistentAccount 'AccountV3) where
+    getHash = theAccountHash @'AccountV3 . getHash
+
+instance (Monad m) => MHashableTo m Hash.Hash (PersistentAccount 'AccountV3)
+
 instance (MonadBlobStore m, IsAccountVersion av) => BlobStorable m (PersistentAccount av) where
     storeUpdate acc@PersistentAccount{..} = do
         (pEnduringData, newEnduringData) <- storeUpdate accountEnduringData
@@ -721,7 +825,7 @@ getReleaseSummary acc = do
         Some (rsRef, _) -> toAccountReleaseSummary =<< refLoad rsRef
 
 -- | Get the release schedule for an account.
-getReleaseSchedule :: (MonadBlobStore m) => PersistentAccount 'AccountV2 -> m (TARS.AccountReleaseSchedule 'AccountV2)
+getReleaseSchedule :: (MonadBlobStore m, IsAccountVersion av, AccountStructureVersionFor av ~ 'AccountStructureV1) => PersistentAccount av -> m (TARS.AccountReleaseSchedule av)
 getReleaseSchedule acc = do
     let ed = enduringData acc
     TARS.fromAccountReleaseScheduleV1 <$> case paedReleaseSchedule ed of
@@ -748,7 +852,7 @@ getBaker acc = do
                         { _stakedAmount = accountStakedAmount acc,
                           _stakeEarnings = paseBakerRestakeEarnings,
                           _accountBakerInfo = abi,
-                          _bakerPendingChange = PendingChangeEffectiveV1 <$> paseBakerPendingChange
+                          _bakerPendingChange = paseBakerPendingChange
                         }
             return $ Just bkr
         _ -> return Nothing
@@ -776,7 +880,7 @@ getBakerAndInfoRef acc = do
                         { _stakedAmount = accountStakedAmount acc,
                           _stakeEarnings = paseBakerRestakeEarnings,
                           _accountBakerInfo = bi,
-                          _bakerPendingChange = PendingChangeEffectiveV1 <$> paseBakerPendingChange
+                          _bakerPendingChange = paseBakerPendingChange
                         }
             return $ Just (bkr, paseBakerInfo)
         _ -> return Nothing
@@ -793,7 +897,7 @@ getDelegator acc = do
                           _delegationStakedAmount = accountStakedAmount acc,
                           _delegationStakeEarnings = paseDelegatorRestakeEarnings,
                           _delegationTarget = paseDelegatorTarget,
-                          _delegationPendingChange = PendingChangeEffectiveV1 <$> paseDelegatorPendingChange
+                          _delegationPendingChange = paseDelegatorPendingChange
                         }
             return $ Just del
         _ -> return Nothing
@@ -822,22 +926,37 @@ getStakeDetails acc = do
             StakeDetailsBaker
                 { sdStakedCapital = accountStakedAmount acc,
                   sdRestakeEarnings = paseBakerRestakeEarnings,
-                  sdPendingChange = PendingChangeEffectiveV1 <$> paseBakerPendingChange
+                  sdPendingChange = paseBakerPendingChange
                 }
         PersistentAccountStakeEnduringDelegator{..} ->
             StakeDetailsDelegator
                 { sdStakedCapital = accountStakedAmount acc,
                   sdRestakeEarnings = paseDelegatorRestakeEarnings,
-                  sdPendingChange = PendingChangeEffectiveV1 <$> paseDelegatorPendingChange,
+                  sdPendingChange = paseDelegatorPendingChange,
                   sdDelegationTarget = paseDelegatorTarget
                 }
         PersistentAccountStakeEnduringNone -> StakeDetailsNone
 
+getStakeCooldown ::
+    (MonadBlobStore m) =>
+    PersistentAccount av ->
+    m (CooldownQueue av)
+getStakeCooldown acc = do
+    let ed = enduringData acc
+    return $ paedStakeCooldown ed
+
 -- ** Updates
 
 -- | Apply account updates to an account. It is assumed that the address in
 --  account updates and account are the same.
-updateAccount :: (MonadBlobStore m) => AccountUpdate -> PersistentAccount 'AccountV2 -> m (PersistentAccount 'AccountV2)
+updateAccount ::
+    ( MonadBlobStore m,
+      IsAccountVersion av,
+      AccountStructureVersionFor av ~ 'AccountStructureV1
+    ) =>
+    AccountUpdate ->
+    PersistentAccount av ->
+    m (PersistentAccount av)
 updateAccount !upd !acc0 = do
     let ed0 = enduringData acc0
     (ed1, enduringRehash1, additionalLocked) <- case upd ^. auReleaseSchedule of
@@ -896,10 +1015,10 @@ updateAccount !upd !acc0 = do
 -- | Helper function. Apply an update to the 'PersistentAccountEnduringData' on an account,
 --  recomputing the hash.
 updateEnduringData ::
-    (MonadBlobStore m) =>
-    (PersistentAccountEnduringData 'AccountV2 -> m (PersistentAccountEnduringData 'AccountV2)) ->
-    PersistentAccount 'AccountV2 ->
-    m (PersistentAccount 'AccountV2)
+    (MonadBlobStore m, IsAccountVersion av, AccountStructureVersionFor av ~ 'AccountStructureV1) =>
+    (PersistentAccountEnduringData av -> m (PersistentAccountEnduringData av)) ->
+    PersistentAccount av ->
+    m (PersistentAccount av)
 updateEnduringData f acc = do
     let ed = enduringData acc
     newEnduring <- refMake =<< rehashAccountEnduringData =<< f ed
@@ -907,10 +1026,10 @@ updateEnduringData f acc = do
 
 -- | Apply an update to the 'PersistingAccountData' on an account, recomputing the hash.
 updatePersistingData ::
-    (MonadBlobStore m) =>
+    (MonadBlobStore m, IsAccountVersion av, AccountStructureVersionFor av ~ 'AccountStructureV1) =>
     (PersistingAccountData -> PersistingAccountData) ->
-    PersistentAccount 'AccountV2 ->
-    m (PersistentAccount 'AccountV2)
+    PersistentAccount av ->
+    m (PersistentAccount av)
 updatePersistingData f = updateEnduringData $ \ed -> do
     let pd = eagerBufferedDeref (paedPersistingData ed)
     newPersisting <- refMake $! f pd
@@ -918,10 +1037,10 @@ updatePersistingData f = updateEnduringData $ \ed -> do
 
 -- | Helper function. Update the 'PersistentAccountStakeEnduring' component of an account.
 updateStake ::
-    (MonadBlobStore m) =>
-    (PersistentAccountStakeEnduring 'AccountV2 -> m (PersistentAccountStakeEnduring 'AccountV2)) ->
-    PersistentAccount 'AccountV2 ->
-    m (PersistentAccount 'AccountV2)
+    (MonadBlobStore m, IsAccountVersion av, AccountStructureVersionFor av ~ 'AccountStructureV1) =>
+    (PersistentAccountStakeEnduring av -> m (PersistentAccountStakeEnduring av)) ->
+    PersistentAccount av ->
+    m (PersistentAccount av)
 updateStake f = updateEnduringData $ \ed -> do
     newStake <- f (paedStake ed)
     return $! ed{paedStake = newStake}
@@ -935,7 +1054,7 @@ updateStake f = updateEnduringData $ \ed -> do
 --  * At least one credential remains after all removals and additions.
 --  * Any new threshold is at most the number of accounts remaining (and at least 1).
 updateAccountCredentials ::
-    (MonadBlobStore m) =>
+    (MonadBlobStore m, IsAccountVersion av, AccountStructureVersionFor av ~ 'AccountStructureV1) =>
     -- | Credentials to remove
     [CredentialIndex] ->
     -- | Credentials to add
@@ -943,22 +1062,22 @@ updateAccountCredentials ::
     -- | New account threshold
     AccountThreshold ->
     -- | Account to update
-    PersistentAccount 'AccountV2 ->
-    m (PersistentAccount 'AccountV2)
+    PersistentAccount av ->
+    m (PersistentAccount av)
 updateAccountCredentials cuRemove cuAdd cuAccountThreshold =
     updatePersistingData (updateCredentials cuRemove cuAdd cuAccountThreshold)
 
 -- | Optionally update the verification keys and signature threshold for an account.
 --  Precondition: The credential with given credential index exists.
 updateAccountCredentialKeys ::
-    (MonadBlobStore m) =>
+    (MonadBlobStore m, IsAccountVersion av, AccountStructureVersionFor av ~ 'AccountStructureV1) =>
     -- | Credential to update
     CredentialIndex ->
     -- | New public keys
     CredentialPublicKeys ->
     -- | Account to update
-    PersistentAccount 'AccountV2 ->
-    m (PersistentAccount 'AccountV2)
+    PersistentAccount av ->
+    m (PersistentAccount av)
 updateAccountCredentialKeys credIndex credKeys = updatePersistingData (updateCredentialKeys credIndex credKeys)
 
 -- | Add an amount to the account's balance.
@@ -968,16 +1087,16 @@ addAmount !amt acc = return $! acc{accountAmount = accountAmount acc + amt}
 -- | Add a baker to an account for account version 1.
 --  This will replace any existing staking information on the account.
 addBakerV1 ::
-    (MonadBlobStore m) =>
+    (MonadBlobStore m, IsAccountVersion av, AccountStructureVersionFor av ~ 'AccountStructureV1) =>
     -- | Extended baker info
-    BakerInfoEx 'AccountV2 ->
+    BakerInfoEx av ->
     -- | Baker's equity capital
     Amount ->
     -- | Whether earnings are restaked
     Bool ->
     -- | Account to add baker to
-    PersistentAccount 'AccountV2 ->
-    m (PersistentAccount 'AccountV2)
+    PersistentAccount av ->
+    m (PersistentAccount av)
 addBakerV1 binfo stake restake acc = do
     let ed = enduringData acc
     binfoRef <- refMake $! binfo
@@ -997,10 +1116,10 @@ addBakerV1 binfo stake restake acc = do
 -- | Add a delegator to an account.
 --  This will replace any existing staking information on the account.
 addDelegator ::
-    (MonadBlobStore m) =>
-    AccountDelegation 'AccountV2 ->
-    PersistentAccount 'AccountV2 ->
-    m (PersistentAccount 'AccountV2)
+    (MonadBlobStore m, IsAccountVersion av, AccountStructureVersionFor av ~ 'AccountStructureV1) =>
+    AccountDelegation av ->
+    PersistentAccount av ->
+    m (PersistentAccount av)
 addDelegator AccountDelegationV1{..} acc = do
     let ed = enduringData acc
     let del =
@@ -1020,10 +1139,14 @@ addDelegator AccountDelegationV1{..} acc = do
 -- | Update the pool info on a baker account.
 --  This MUST only be called with an account that is a baker.
 updateBakerPoolInfo ::
-    (MonadBlobStore m) =>
+    ( MonadBlobStore m,
+      AVSupportsDelegation av,
+      IsAccountVersion av,
+      AccountStructureVersionFor av ~ 'AccountStructureV1
+    ) =>
     BakerPoolInfoUpdate ->
-    PersistentAccount 'AccountV2 ->
-    m (PersistentAccount 'AccountV2)
+    PersistentAccount av ->
+    m (PersistentAccount av)
 updateBakerPoolInfo upd = updateEnduringData $ \ed -> case paedStake ed of
     baker@PersistentAccountStakeEnduringBaker{} -> do
         oldInfo <- refLoad (paseBakerInfo baker)
@@ -1038,10 +1161,14 @@ updateBakerPoolInfo upd = updateEnduringData $ \ed -> case paedStake ed of
 -- | Set the baker keys on a baker account.
 --  This MUST only be called with an account that is a baker.
 setBakerKeys ::
-    (MonadBlobStore m) =>
+    ( MonadBlobStore m,
+      AVSupportsDelegation av,
+      IsAccountVersion av,
+      AccountStructureVersionFor av ~ 'AccountStructureV1
+    ) =>
     BakerKeyUpdate ->
-    PersistentAccount 'AccountV2 ->
-    m (PersistentAccount 'AccountV2)
+    PersistentAccount av ->
+    m (PersistentAccount av)
 setBakerKeys upd = updateStake $ \case
     baker@PersistentAccountStakeEnduringBaker{} -> do
         oldInfo <- refLoad (paseBakerInfo baker)
@@ -1072,10 +1199,10 @@ setStake newStake acc = return $! acc{accountStakedAmount = newStake}
 -- | Set whether a baker or delegator account restakes its earnings.
 --  This MUST only be called with an account that is either a baker or delegator.
 setRestakeEarnings ::
-    (MonadBlobStore m) =>
+    (MonadBlobStore m, IsAccountVersion av, AccountStructureVersionFor av ~ 'AccountStructureV1) =>
     Bool ->
-    PersistentAccount 'AccountV2 ->
-    m (PersistentAccount 'AccountV2)
+    PersistentAccount av ->
+    m (PersistentAccount av)
 setRestakeEarnings newRestake =
     updateStake $
         return . \case
@@ -1088,28 +1215,26 @@ setRestakeEarnings newRestake =
 -- | Set the pending change on baker or delegator account.
 --  This MUST only be called with an account that is either a baker or delegator.
 setStakePendingChange ::
-    (MonadBlobStore m) =>
-    StakePendingChange 'AccountV2 ->
-    PersistentAccount 'AccountV2 ->
-    m (PersistentAccount 'AccountV2)
+    (MonadBlobStore m, IsAccountVersion av, AccountStructureVersionFor av ~ 'AccountStructureV1) =>
+    StakePendingChange av ->
+    PersistentAccount av ->
+    m (PersistentAccount av)
 setStakePendingChange newPC =
     updateStake $
         return . \case
             baker@PersistentAccountStakeEnduringBaker{} ->
-                baker{paseBakerPendingChange = newPC'}
+                baker{paseBakerPendingChange = newPC}
             del@PersistentAccountStakeEnduringDelegator{} ->
-                del{paseDelegatorPendingChange = newPC'}
+                del{paseDelegatorPendingChange = newPC}
             PersistentAccountStakeEnduringNone -> error "setStakePendingChange invariant violation: account is not a baker or delegator"
-  where
-    newPC' = pendingChangeEffectiveTimestamp <$> newPC
 
 -- | Set the target of a delegating account.
 --  This MUST only be called with an account that is a delegator.
 setDelegationTarget ::
-    (MonadBlobStore m) =>
+    (MonadBlobStore m, IsAccountVersion av, AccountStructureVersionFor av ~ 'AccountStructureV1) =>
     DelegationTarget ->
-    PersistentAccount 'AccountV2 ->
-    m (PersistentAccount 'AccountV2)
+    PersistentAccount av ->
+    m (PersistentAccount av)
 setDelegationTarget newTarget =
     updateStake $
         return . \case
@@ -1122,9 +1247,9 @@ setDelegationTarget newTarget =
 
 -- | Remove any staking on an account.
 removeStaking ::
-    (MonadBlobStore m) =>
-    PersistentAccount 'AccountV2 ->
-    m (PersistentAccount 'AccountV2)
+    (MonadBlobStore m, IsAccountVersion av, AccountStructureVersionFor av ~ 'AccountStructureV1) =>
+    PersistentAccount av ->
+    m (PersistentAccount av)
 removeStaking acc0 = do
     acc1 <- updateStake (const $ return PersistentAccountStakeEnduringNone) acc0
     return $! acc1{accountStakedAmount = 0}
@@ -1132,10 +1257,14 @@ removeStaking acc0 = do
 -- | Set the commission rates on a baker account.
 --  This MUST only be called with an account that is a baker.
 setCommissionRates ::
-    (MonadBlobStore m) =>
+    ( MonadBlobStore m,
+      IsAccountVersion av,
+      AVSupportsDelegation av,
+      AccountStructureVersionFor av ~ 'AccountStructureV1
+    ) =>
     CommissionRates ->
-    PersistentAccount 'AccountV2 ->
-    m (PersistentAccount 'AccountV2)
+    PersistentAccount av ->
+    m (PersistentAccount av)
 setCommissionRates rates = updateStake $ \case
     baker@PersistentAccountStakeEnduringBaker{} -> do
         oldInfo <- refLoad (paseBakerInfo baker)
@@ -1151,10 +1280,10 @@ setCommissionRates rates = updateStake $ \case
 --  This returns the next timestamp at which a release is scheduled for the account, if any,
 --  as well as the updated account.
 unlockReleases ::
-    (MonadBlobStore m) =>
+    (MonadBlobStore m, IsAccountVersion av, AccountStructureVersionFor av ~ 'AccountStructureV1) =>
     Timestamp ->
-    PersistentAccount 'AccountV2 ->
-    m (Maybe Timestamp, PersistentAccount 'AccountV2)
+    PersistentAccount av ->
+    m (Maybe Timestamp, PersistentAccount av)
 unlockReleases ts acc = do
     let ed = enduringData acc
     case paedReleaseSchedule ed of
@@ -1175,9 +1304,17 @@ unlockReleases ts acc = do
 -- ** Creation
 
 -- | Make a 'PersistentAccount' from an 'Transient.Account'.
-makePersistentAccount :: (MonadBlobStore m) => Transient.Account 'AccountV2 -> m (PersistentAccount 'AccountV2)
+makePersistentAccount ::
+    forall m av.
+    ( MonadBlobStore m,
+      IsAccountVersion av,
+      AccountStructureVersionFor av ~ 'AccountStructureV1,
+      TARS.AccountReleaseSchedule' av ~ TARSV1.AccountReleaseSchedule
+    ) =>
+    Transient.Account av ->
+    m (PersistentAccount av)
 makePersistentAccount Transient.Account{..} = do
-    paedPersistingData <- refMake $! _unhashed _accountPersisting
+    paedPersistingData :: EagerBufferedRef PersistingAccountData <- refMake $! _unhashed _accountPersisting
     (accountStakedAmount, !paedStake) <- case _accountStaking of
         AccountStakeNone -> return (0, PersistentAccountStakeEnduringNone)
         AccountStakeBaker AccountBaker{..} -> do
@@ -1185,7 +1322,7 @@ makePersistentAccount Transient.Account{..} = do
             let baker =
                     PersistentAccountStakeEnduringBaker
                         { paseBakerRestakeEarnings = _stakeEarnings,
-                          paseBakerPendingChange = pendingChangeEffectiveTimestamp <$> _bakerPendingChange,
+                          paseBakerPendingChange = _bakerPendingChange,
                           ..
                         }
             return (_stakedAmount, baker)
@@ -1195,16 +1332,16 @@ makePersistentAccount Transient.Account{..} = do
                         { paseDelegatorRestakeEarnings = _delegationStakeEarnings,
                           paseDelegatorId = _delegationIdentity,
                           paseDelegatorTarget = _delegationTarget,
-                          paseDelegatorPendingChange = pendingChangeEffectiveTimestamp <$> _delegationPendingChange
+                          paseDelegatorPendingChange = _delegationPendingChange
                         }
             return (_delegationStakedAmount, del)
-    paedEncryptedAmount <- do
+    paedEncryptedAmount :: Nullable (LazyBufferedRef PersistentAccountEncryptedAmount) <- do
         ea <- storePersistentAccountEncryptedAmount _accountEncryptedAmount
         isInit <- isInitialPersistentAccountEncryptedAmount ea
         if isInit
             then return Null
             else Some <$!> refMake ea
-    paedReleaseSchedule <- do
+    paedReleaseSchedule :: Nullable (LazyBufferedRef AccountReleaseSchedule, Amount) <- do
         rs <- makePersistentAccountReleaseSchedule (TARS.theAccountReleaseSchedule _accountReleaseSchedule)
         if isEmptyAccountReleaseSchedule rs
             then return Null
@@ -1214,11 +1351,20 @@ makePersistentAccount Transient.Account{..} = do
                 return (Some (rsRef, lockedBal))
     accountEnduringData <-
         refMake
-            =<< makeAccountEnduringData
-                paedPersistingData
-                paedEncryptedAmount
-                paedReleaseSchedule
-                paedStake
+            =<< case accountVersion @av of
+                SAccountV2 ->
+                    makeAccountEnduringDataAV2
+                        paedPersistingData
+                        paedEncryptedAmount
+                        paedReleaseSchedule
+                        paedStake
+                SAccountV3 ->
+                    makeAccountEnduringDataAV3
+                        paedPersistingData
+                        paedEncryptedAmount
+                        paedReleaseSchedule
+                        paedStake
+                        _accountStakeCooldown
     return $!
         PersistentAccount
             { accountNonce = _accountNonce,
@@ -1228,11 +1374,15 @@ makePersistentAccount Transient.Account{..} = do
 
 -- | Create an empty account with the given public key, address and credential.
 newAccount ::
-    (MonadBlobStore m) =>
+    forall m av.
+    ( MonadBlobStore m,
+      IsAccountVersion av,
+      AccountStructureVersionFor av ~ 'AccountStructureV1
+    ) =>
     GlobalContext ->
     AccountAddress ->
     AccountCredential ->
-    m (PersistentAccount 'AccountV2)
+    m (PersistentAccount av)
 newAccount cryptoParams _accountAddress credential = do
     let creds = Map.singleton initialCredentialIndex credential
     let newPData =
@@ -1243,10 +1393,12 @@ newAccount cryptoParams _accountAddress credential = do
                   _accountRemovedCredentials = emptyHashedRemovedCredentials,
                   ..
                 }
-    paedPersistingData <- refMake newPData
+    paedPersistingData :: EagerBufferedRef PersistingAccountData <- refMake newPData
     accountEnduringData <-
         refMake
-            =<< makeAccountEnduringData paedPersistingData Null Null PersistentAccountStakeEnduringNone
+            =<< case accountVersion @av of
+                SAccountV2 -> makeAccountEnduringDataAV2 paedPersistingData Null Null PersistentAccountStakeEnduringNone
+                SAccountV3 -> makeAccountEnduringDataAV3 paedPersistingData Null Null PersistentAccountStakeEnduringNone emptyCooldownQueue
     return $!
         PersistentAccount
             { accountNonce = minNonce,
@@ -1258,15 +1410,19 @@ newAccount cryptoParams _accountAddress credential = do
 -- | Make a persistent account from a genesis account.
 --  The data is immediately flushed to disc and cached.
 makeFromGenesisAccount ::
-    forall pv m.
-    (MonadBlobStore m, IsProtocolVersion pv, AccountVersionFor pv ~ 'AccountV2) =>
+    forall pv av m.
+    ( MonadBlobStore m,
+      IsProtocolVersion pv,
+      AccountVersionFor pv ~ av,
+      AccountStructureVersionFor av ~ 'AccountStructureV1
+    ) =>
     SProtocolVersion pv ->
     GlobalContext ->
     ChainParameters pv ->
     GenesisAccount ->
-    m (PersistentAccount 'AccountV2)
+    m (PersistentAccount av)
 makeFromGenesisAccount spv cryptoParams chainParameters GenesisAccount{..} = do
-    paedPersistingData <-
+    paedPersistingData :: EagerBufferedRef PersistingAccountData <-
         refMakeFlushed $
             PersistingAccountData
                 { _accountEncryptionKey =
@@ -1294,7 +1450,9 @@ makeFromGenesisAccount spv cryptoParams chainParameters GenesisAccount{..} = do
 
     accountEnduringData <-
         refMakeFlushed
-            =<< makeAccountEnduringData paedPersistingData Null Null stakeEnduring
+            =<< case accountVersion @av of
+                SAccountV2 -> makeAccountEnduringDataAV2 paedPersistingData Null Null stakeEnduring
+                SAccountV3 -> makeAccountEnduringDataAV3 paedPersistingData Null Null stakeEnduring emptyCooldownQueue
     return $!
         PersistentAccount
             { accountNonce = minNonce,
@@ -1316,12 +1474,41 @@ migrateEnduringData ed = do
         newRSRef <- migrateReference migrateAccountReleaseSchedule oldRSRef
         return (newRSRef, lockedAmt)
     paedStake <- migratePersistentAccountStakeEnduring (paedStake ed)
+    let paedStakeCooldown = emptyCooldownQueue
     return $!
         PersistentAccountEnduringData
             { paedHash = paedHash ed,
               ..
             }
 
+migrateEnduringDataV2toV3 ::
+    (SupportMigration m t) =>
+    PersistentAccountEnduringData 'AccountV2 ->
+    t m (PersistentAccountEnduringData 'AccountV3)
+migrateEnduringDataV2toV3 ed = do
+    paedPersistingData <- migrateEagerBufferedRef return (paedPersistingData ed)
+    paedEncryptedAmount <- forM (paedEncryptedAmount ed) $ migrateReference migratePersistentEncryptedAmount
+    paedReleaseSchedule <- forM (paedReleaseSchedule ed) $ \(oldRSRef, lockedAmt) -> do
+        newRSRef <- migrateReference migrateAccountReleaseSchedule oldRSRef
+        return (newRSRef, lockedAmt)
+    paedStake <- migratePersistentAccountStakeEnduringV2toV3 (paedStake ed)
+    let paedStakeCooldown = undefined -- FIXME: fix
+    makeAccountEnduringDataAV3 paedPersistingData paedEncryptedAmount paedReleaseSchedule paedStake paedStakeCooldown
+
+migrateEnduringDataV3toV3 ::
+    (SupportMigration m t) =>
+    PersistentAccountEnduringData 'AccountV3 ->
+    t m (PersistentAccountEnduringData 'AccountV3)
+migrateEnduringDataV3toV3 ed = do
+    paedPersistingData <- migrateEagerBufferedRef return (paedPersistingData ed)
+    paedEncryptedAmount <- forM (paedEncryptedAmount ed) $ migrateReference migratePersistentEncryptedAmount
+    paedReleaseSchedule <- forM (paedReleaseSchedule ed) $ \(oldRSRef, lockedAmt) -> do
+        newRSRef <- migrateReference migrateAccountReleaseSchedule oldRSRef
+        return (newRSRef, lockedAmt)
+    paedStake <- migratePersistentAccountStakeEnduring (paedStake ed)
+    -- FIXME: migrate the stake cooldown correctly if the type of 'paedStakeCooldown' changes.
+    makeAccountEnduringDataAV3 paedPersistingData paedEncryptedAmount paedReleaseSchedule paedStake (paedStakeCooldown ed :: CooldownQueue 'AccountV3)
+
 -- | A trivial migration from account version 2 to
 --  account version 2.
 --  In particular this function only migrates the underlying reference to
@@ -1343,17 +1530,55 @@ migrateV2ToV2 acc = do
               ..
             }
 
+migrateV2ToV3 ::
+    ( MonadBlobStore m,
+      MonadBlobStore (t m),
+      MonadTrans t
+    ) =>
+    PersistentAccount 'AccountV2 ->
+    t m (PersistentAccount 'AccountV3)
+migrateV2ToV3 acc = do
+    accountEnduringData <- migrateEagerBufferedRef migrateEnduringDataV2toV3 (accountEnduringData acc)
+    return $!
+        PersistentAccount
+            { accountNonce = accountNonce acc,
+              accountAmount = accountAmount acc,
+              accountStakedAmount = accountStakedAmount acc,
+              ..
+            }
+
+migrateV3ToV3 ::
+    ( MonadBlobStore m,
+      MonadBlobStore (t m),
+      MonadTrans t
+    ) =>
+    PersistentAccount 'AccountV3 ->
+    t m (PersistentAccount 'AccountV3)
+migrateV3ToV3 acc = do
+    accountEnduringData <- migrateEagerBufferedRef migrateEnduringDataV3toV3 (accountEnduringData acc)
+    return $!
+        PersistentAccount
+            { accountNonce = accountNonce acc,
+              accountAmount = accountAmount acc,
+              accountStakedAmount = accountStakedAmount acc,
+              ..
+            }
+
 -- | Migration for 'PersistentAccount'. Only supports 'AccountV2'.
 migratePersistentAccount ::
-    ( SupportMigration m t,
-      AccountVersionFor oldpv ~ 'AccountV2
+    forall m t oldpv pv.
+    ( IsProtocolVersion oldpv,
+      SupportMigration m t,
+      AccountStructureVersionFor (AccountVersionFor oldpv) ~ 'AccountStructureV1
     ) =>
     StateMigrationParameters oldpv pv ->
     PersistentAccount (AccountVersionFor oldpv) ->
     t m (PersistentAccount (AccountVersionFor pv))
-migratePersistentAccount StateMigrationParametersTrivial acc = migrateV2ToV2 acc
+migratePersistentAccount StateMigrationParametersTrivial acc = case accountVersion @(AccountVersionFor oldpv) of
+    SAccountV2 -> migrateV2ToV2 acc
+    SAccountV3 -> migrateV3ToV3 acc
 migratePersistentAccount StateMigrationParametersP5ToP6{} acc = migrateV2ToV2 acc
-migratePersistentAccount StateMigrationParametersP6ToP7{} acc = migrateV2ToV2 acc
+migratePersistentAccount StateMigrationParametersP6ToP7{} acc = migrateV2ToV3 acc
 
 -- | Migration for 'PersistentAccount' from 'V0.PersistentAccount'. This supports migration from
 --  'P4' to 'P5'.
@@ -1380,18 +1605,19 @@ migratePersistentAccountFromV0 StateMigrationParametersP4ToP5{} V0.PersistentAcc
             let baker =
                     PersistentAccountStakeEnduringBaker
                         { paseBakerRestakeEarnings = _stakeEarnings,
-                          paseBakerPendingChange = pendingChangeEffectiveTimestamp <$> _bakerPendingChange,
+                          paseBakerPendingChange = coercePendingChangeEffectiveV1 <$> _bakerPendingChange,
                           ..
                         }
             return (_stakedAmount, baker)
         V0.PersistentAccountStakeDelegate dlgRef -> do
             AccountDelegationV1{..} <- lift $ refLoad dlgRef
-            let del =
+            let del :: PersistentAccountStakeEnduring 'AccountV2
+                del =
                     PersistentAccountStakeEnduringDelegator
                         { paseDelegatorRestakeEarnings = _delegationStakeEarnings,
                           paseDelegatorId = _delegationIdentity,
                           paseDelegatorTarget = _delegationTarget,
-                          paseDelegatorPendingChange = pendingChangeEffectiveTimestamp <$> _delegationPendingChange
+                          paseDelegatorPendingChange = coercePendingChangeEffectiveV1 <$> _delegationPendingChange
                         }
             return (_delegationStakedAmount, del)
     paedEncryptedAmount <- do
@@ -1413,7 +1639,7 @@ migratePersistentAccountFromV0 StateMigrationParametersP4ToP5{} V0.PersistentAcc
     (accountEnduringData, _) <-
         refFlush
             =<< refMake
-            =<< makeAccountEnduringData
+            =<< makeAccountEnduringDataAV2
                 paedPersistingData
                 paedEncryptedAmount
                 paedReleaseSchedule
@@ -1428,12 +1654,20 @@ migratePersistentAccountFromV0 StateMigrationParametersP4ToP5{} V0.PersistentAcc
 -- ** Conversion
 
 -- | Converts an account to a transient (i.e. in memory) account. (Used for testing.)
-toTransientAccount :: (MonadBlobStore m) => PersistentAccount 'AccountV2 -> m (Transient.Account 'AccountV2)
+toTransientAccount ::
+    ( MonadBlobStore m,
+      IsAccountVersion av,
+      AccountStructureVersionFor av ~ 'AccountStructureV1,
+      AVSupportsDelegation av
+    ) =>
+    PersistentAccount av ->
+    m (Transient.Account av)
 toTransientAccount acc = do
     let _accountPersisting = makeHashed $ persistingData acc
     _accountEncryptedAmount <- getEncryptedAmount acc
     _accountReleaseSchedule <- getReleaseSchedule acc
     _accountStaking <- getStake acc
+    _accountStakeCooldown <- getStakeCooldown acc
     return $
         Transient.Account
             { _accountNonce = accountNonce acc,
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
index 1c0ba2033..2160f1235 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
@@ -98,6 +98,7 @@ import qualified Control.Monad.Except as MTL
 import Control.Monad.Reader
 import qualified Control.Monad.State.Strict as MTL
 import qualified Control.Monad.Writer.Strict as MTL
+import Data.Bool.Singletons
 import Data.IORef
 import Data.Kind (Type)
 import qualified Data.Map.Strict as Map
@@ -1475,60 +1476,60 @@ doConfigureBaker pbs ai BakerConfigureAdd{..} = do
             let capitalMin = poolParams ^. ppMinimumEquityCapital
             let ranges = poolParams ^. ppCommissionBounds
             if
-                | bcaCapital < capitalMin -> return (BCStakeUnderThreshold, pbs)
-                | not (isInRange bcaTransactionFeeCommission (ranges ^. transactionCommissionRange)) ->
-                    return (BCTransactionFeeCommissionNotInRange, pbs)
-                | not (isInRange bcaBakingRewardCommission (ranges ^. bakingCommissionRange)) ->
-                    return (BCBakingRewardCommissionNotInRange, pbs)
-                | not (isInRange bcaFinalizationRewardCommission (ranges ^. finalizationCommissionRange)) ->
-                    return (BCFinalizationRewardCommissionNotInRange, pbs)
-                | otherwise -> do
-                    let bid = BakerId ai
-                    pab <- refLoad (_birkActiveBakers (bspBirkParameters bsp))
-                    let updAgg Nothing = return (True, Trie.Insert ())
-                        updAgg (Just ()) = return (False, Trie.NoChange)
-                    Trie.adjust updAgg (bkuAggregationKey bcaKeys) (_aggregationKeys pab) >>= \case
-                        -- Aggregation key is a duplicate
-                        (False, _) -> return (BCDuplicateAggregationKey (bkuAggregationKey bcaKeys), pbs)
-                        (True, newAggregationKeys) -> do
-                            newActiveBakers <- Trie.insert bid emptyPersistentActiveDelegators (_activeBakers pab)
-                            newpabref <-
-                                refMake
-                                    PersistentActiveBakers
-                                        { _aggregationKeys = newAggregationKeys,
-                                          _activeBakers = newActiveBakers,
-                                          _passiveDelegators = pab ^. passiveDelegators,
-                                          _totalActiveCapital = addActiveCapital bcaCapital (_totalActiveCapital pab)
-                                        }
-                            let newBirkParams = bspBirkParameters bsp & birkActiveBakers .~ newpabref
-                            let cr =
-                                    CommissionRates
-                                        { _finalizationCommission = bcaFinalizationRewardCommission,
-                                          _bakingCommission = bcaBakingRewardCommission,
-                                          _transactionCommission = bcaTransactionFeeCommission
-                                        }
-                                poolInfo =
-                                    BaseAccounts.BakerPoolInfo
-                                        { _poolOpenStatus = bcaOpenForDelegation,
-                                          _poolMetadataUrl = bcaMetadataURL,
-                                          _poolCommissionRates = cr
-                                        }
-                                bakerInfo = bakerKeyUpdateToInfo bid bcaKeys
-                                bakerInfoEx =
-                                    BaseAccounts.BakerInfoExV1
-                                        { _bieBakerPoolInfo = poolInfo,
-                                          _bieBakerInfo = bakerInfo
-                                        }
-                                updAcc = addAccountBakerV1 bakerInfoEx bcaCapital bcaRestakeEarnings
-                            -- This cannot fail to update the account, since we already looked up the account.
-                            newAccounts <- Accounts.updateAccountsAtIndex' updAcc ai (bspAccounts bsp)
-                            (BCSuccess [] bid,)
-                                <$> storePBS
-                                    pbs
-                                    bsp
-                                        { bspBirkParameters = newBirkParams,
-                                          bspAccounts = newAccounts
-                                        }
+                    | bcaCapital < capitalMin -> return (BCStakeUnderThreshold, pbs)
+                    | not (isInRange bcaTransactionFeeCommission (ranges ^. transactionCommissionRange)) ->
+                        return (BCTransactionFeeCommissionNotInRange, pbs)
+                    | not (isInRange bcaBakingRewardCommission (ranges ^. bakingCommissionRange)) ->
+                        return (BCBakingRewardCommissionNotInRange, pbs)
+                    | not (isInRange bcaFinalizationRewardCommission (ranges ^. finalizationCommissionRange)) ->
+                        return (BCFinalizationRewardCommissionNotInRange, pbs)
+                    | otherwise -> do
+                        let bid = BakerId ai
+                        pab <- refLoad (_birkActiveBakers (bspBirkParameters bsp))
+                        let updAgg Nothing = return (True, Trie.Insert ())
+                            updAgg (Just ()) = return (False, Trie.NoChange)
+                        Trie.adjust updAgg (bkuAggregationKey bcaKeys) (_aggregationKeys pab) >>= \case
+                            -- Aggregation key is a duplicate
+                            (False, _) -> return (BCDuplicateAggregationKey (bkuAggregationKey bcaKeys), pbs)
+                            (True, newAggregationKeys) -> do
+                                newActiveBakers <- Trie.insert bid emptyPersistentActiveDelegators (_activeBakers pab)
+                                newpabref <-
+                                    refMake
+                                        PersistentActiveBakers
+                                            { _aggregationKeys = newAggregationKeys,
+                                              _activeBakers = newActiveBakers,
+                                              _passiveDelegators = pab ^. passiveDelegators,
+                                              _totalActiveCapital = addActiveCapital bcaCapital (_totalActiveCapital pab)
+                                            }
+                                let newBirkParams = bspBirkParameters bsp & birkActiveBakers .~ newpabref
+                                let cr =
+                                        CommissionRates
+                                            { _finalizationCommission = bcaFinalizationRewardCommission,
+                                              _bakingCommission = bcaBakingRewardCommission,
+                                              _transactionCommission = bcaTransactionFeeCommission
+                                            }
+                                    poolInfo =
+                                        BaseAccounts.BakerPoolInfo
+                                            { _poolOpenStatus = bcaOpenForDelegation,
+                                              _poolMetadataUrl = bcaMetadataURL,
+                                              _poolCommissionRates = cr
+                                            }
+                                    bakerInfo = bakerKeyUpdateToInfo bid bcaKeys
+                                    bakerInfoEx =
+                                        BaseAccounts.BakerInfoExV1
+                                            { _bieBakerPoolInfo = poolInfo,
+                                              _bieBakerInfo = bakerInfo
+                                            }
+                                    updAcc = addAccountBakerV1 bakerInfoEx bcaCapital bcaRestakeEarnings
+                                -- This cannot fail to update the account, since we already looked up the account.
+                                newAccounts <- Accounts.updateAccountsAtIndex' updAcc ai (bspAccounts bsp)
+                                (BCSuccess [] bid,)
+                                    <$> storePBS
+                                        pbs
+                                        bsp
+                                            { bspBirkParameters = newBirkParams,
+                                              bspAccounts = newAccounts
+                                            }
 doConfigureBaker pbs ai BakerConfigureUpdate{..} = do
     origBSP <- loadPBS pbs
     cp <- lookupCurrentParameters (bspUpdates origBSP)
@@ -1539,7 +1540,7 @@ doConfigureBaker pbs ai BakerConfigureUpdate{..} = do
         uKeys <- updateKeys baker
         uRestake <- updateRestakeEarnings baker
         uPoolInfo <- updateBakerPoolInfo baker cp
-        uCapital <- updateCapital baker cp
+        uCapital <- updateCapital (sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv))) baker cp
         -- Compose together the transformations and apply them to the account.
         let updAcc = uKeys >=> uRestake >=> uPoolInfo >=> uCapital
         modifyAccount' updAcc
@@ -1657,7 +1658,20 @@ doConfigureBaker pbs ai BakerConfigureUpdate{..} = do
         if oldBkr ^. BaseAccounts.poolCommissionRates . finalizationCommission == frc
             then return pu
             else return $! pu{updFinalizationRewardCommission = Just frc}
-    updateCapital oldBkr cp = ifPresent bcuCapital $ \capital -> do
+    updateCapital ::
+        SBool (SupportsFlexibleCooldown (AccountVersionFor pv)) ->
+        AccountBaker (AccountVersionFor pv) ->
+        ChainParameters' (ChainParametersVersionFor pv) ->
+        MTL.StateT
+            (BlockStatePointers pv)
+            ( MTL.WriterT
+                [BakerConfigureUpdateChange]
+                (MTL.ExceptT BakerConfigureResult m)
+            )
+            ( PersistentAccount (AccountVersionFor pv) ->
+              m (PersistentAccount (AccountVersionFor pv))
+            )
+    updateCapital SFalse oldBkr cp = ifPresent bcuCapital $ \capital -> do
         when (_bakerPendingChange oldBkr /= BaseAccounts.NoChange) (MTL.throwError BCChangePending)
         let capitalMin = cp ^. cpPoolParameters . ppMinimumEquityCapital
         let cooldownDuration = cp ^. cpCooldownParameters . cpPoolOwnerCooldown
@@ -1689,6 +1703,7 @@ doConfigureBaker pbs ai BakerConfigureUpdate{..} = do
                         MTL.modify' $ \bsp -> bsp{bspBirkParameters = birkParams & birkActiveBakers .~ newActiveBkrs}
                         MTL.tell [BakerConfigureStakeIncreased capital]
                         return $ setAccountStake capital
+    updateCapital STrue oldBkr cp = undefined
 
 doConstrainBakerCommission ::
     (SupportsPersistentState pv m, PVSupportsDelegation pv) =>
@@ -1828,7 +1843,7 @@ doConfigureDelegation pbs ai DelegationConfigureUpdate{..} = do
     res <- MTL.runExceptT $ MTL.runWriterT $ flip MTL.execStateT origBSP $ do
         oldTarget <- updateDelegationTarget
         updateRestakeEarnings
-        oldCapital <- updateCapital cp
+        oldCapital <- updateCapital (sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv))) cp
         checkOverdelegation oldCapital oldTarget cp
     case res of
         Left errorRes -> return (errorRes, pbs)
@@ -1879,7 +1894,17 @@ doConfigureDelegation pbs ai DelegationConfigureUpdate{..} = do
         unless (acctDlg ^. BaseAccounts.delegationStakeEarnings == restakeEarnings) $ do
             modifyAccount (setAccountRestakeEarnings restakeEarnings)
         MTL.tell [DelegationConfigureRestakeEarnings restakeEarnings]
-    updateCapital cp = do
+    updateCapital ::
+        SBool (SupportsFlexibleCooldown (AccountVersionFor pv)) ->
+        ChainParameters pv ->
+        MTL.StateT
+            (BlockStatePointers pv)
+            ( MTL.WriterT
+                [DelegationConfigureUpdateChange]
+                (MTL.ExceptT DelegationConfigureResult m)
+            )
+            Amount
+    updateCapital SFalse cp = do
         ad <- getAccountOrFail
         forM_ dcuCapital $ \capital -> do
             when (BaseAccounts._delegationPendingChange ad /= BaseAccounts.NoChange) (MTL.throwError DCChangePending)
@@ -1906,6 +1931,7 @@ doConfigureDelegation pbs ai DelegationConfigureUpdate{..} = do
                         modifyAccount $ setAccountStake capital
                         MTL.tell [DelegationConfigureStakeIncreased capital]
         return $ BaseAccounts._delegationStakedAmount ad
+    updateCapital STrue cp = undefined
     addTotalsInActiveBakers ab0 ad delta = do
         let ab1 = ab0 & totalActiveCapital %~ addActiveCapital delta
         case ad ^. BaseAccounts.delegationTarget of
@@ -2191,8 +2217,8 @@ doMint pbs mint = do
             bspBank bsp
                 & unhashed
                     %~ (Rewards.totalGTU +~ mintTotal mint)
-                        . (Rewards.bakingRewardAccount +~ mintBakingReward mint)
-                        . (Rewards.finalizationRewardAccount +~ mintFinalizationReward mint)
+                    . (Rewards.bakingRewardAccount +~ mintBakingReward mint)
+                    . (Rewards.finalizationRewardAccount +~ mintFinalizationReward mint)
     let updAcc = addAccountAmount $ mintDevelopmentCharge mint
     foundationAccount <- (^. cpFoundationAccount) <$> lookupCurrentParameters (bspUpdates bsp)
     newAccounts <- Accounts.updateAccountsAtIndex' updAcc foundationAccount (bspAccounts bsp)
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Cooldown.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Cooldown.hs
new file mode 100644
index 000000000..5fee15ab6
--- /dev/null
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Cooldown.hs
@@ -0,0 +1,18 @@
+-- {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+-- {-# LANGUAGE StandaloneDeriving #-}
+-- {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Concordium.GlobalState.Persistent.Cooldown where
+
+import Concordium.GlobalState.Persistent.ReleaseSchedule
+import Concordium.Types
+
+data AccountsInCooldown = AccountsInCooldown
+    { cooldown :: NewReleaseSchedule,
+      preCooldown :: [AccountIndex],
+      prePreCooldown :: [AccountIndex]
+    }

From ec3a173148593f2bd9a1f489ae35821de728b951 Mon Sep 17 00:00:00 2001
From: Emil B <eb@concordium.com>
Date: Tue, 2 Apr 2024 15:54:43 +0200
Subject: [PATCH 03/81] Delete .dat file.

---
 concordium-consensus/blb99190-530.dat | Bin 36576 -> 0 bytes
 1 file changed, 0 insertions(+), 0 deletions(-)
 delete mode 100644 concordium-consensus/blb99190-530.dat

diff --git a/concordium-consensus/blb99190-530.dat b/concordium-consensus/blb99190-530.dat
deleted file mode 100644
index e4570989e20dbb12f52cc6ad875f51f0bc8b3aeb..0000000000000000000000000000000000000000
GIT binary patch
literal 0
HcmV?d00001

literal 36576
zcmd41bC4z7*2Y=3?dq~^+qP}nwrzFUw!3WG=(252_r33Y5p!cEX6_$f#H@(SC-*)(
z*KhAU=VWF)u>b)66_7yx*8ka45T#qCX8Yx~+L&{&VLDrg*~+h)`JpH!x=gJHB*QFJ
z9Q@DFe;okE|G$mT;M?TyjC`1I8Gk9}AfFfeWf<ZvMWGf6w!=V89wLqX*8d3@l<LIZ
z?CwUCzK8^vWQcYHz5{X;YYQXmN}DG~^3ycP%#cuKsAtPL<erqd=rNb%$-jy;b7T;p
z?bnY@z<(wL2mtu!kW64!oIgg+PRI{<jV5b$?;(USl8(^9VhJKNj@#`4=D$w=H~XK9
zL<SE7egF&r(EAVV|Ev6OkN<z1NALeO`F}hAKP$udw*s#J)BaC^_>T_yf7<{4VFO7-
z|I-%yw*nRXqy69i#6O?^M;>CyKmGsC0f2=4&lqG2V-s6v3ug~Kdq+FhKMhBk{}Tt0
zcDqo@khYRcnqm|!S6&4_U>+@(=G+dNFU!e?j$Ng0t#ZQm>WOvz&Upj1K{(u*v`eM0
z=#Z=LQ?-y6P9|rfVKqCO@uLN+dEKCM(@$Q4N%|HEIax>Tu*wHi2ZYKONV1^eCJrir
z6atitW(YxH_`q}Vjh_psNdel}bAQeax(b-I47Brl(O-46kD$Bl&y?}fd5!7DiP~*$
z+Y*kFBcTm+dq4_-K^9cU`ZE2tjNZ8zM06M%vzE){Srr6D4jJ2;c|G6{Q+xLcdcg@X
zs<5$O$j}N`73ux;1c`^~M)IQolJTDf0@@-R%*s{7<DFHjq5W+VpUuR#Di#t`+wXY*
zhqD+%*>8n}dwP(T)p{i*e<GRNmiUtXns9HG)(sD=uatbL8~;k;$VlsSobga^c#lt+
zPuA|gYto%cGAb#)PMUe*tz<*=kVgo7fij3qh$c_*d55|WPzn_eB1wDPdptfYL@|Ki
z^II0$2MFic&ZWI1`F+;RQE3kV&q=w}XyR1@ND0)`=9FZlgl+ONp@6|OL#s-@6W3vW
zz7@*r)__D99ktDPbn)urZDqoguqo_~!r9+gm%;38Ct5jxfisVMNk2N5C2rI8oSsOY
z@dAGGh~sa6pTk#;Ne#*z0Ki{}p)?b(_gK(w7o@4k3&hW~#?B(R^Pr`62Emd`n5@v_
zvP>JVde5?+JCVj4M`fp<kda;D8mk5l@TS<X*%Rjnxof9-v0_OVAm7SRoz1op65+{U
zg1tuW@Zk&;&wHZwtQ0(S?RR_NfteUa>fT3&yLVDVpgNy{kvIYUh(h?Hl$0CpX%~*u
zS1QCFb}>DAA$`Z)E$N{kIC0iU6pq*H_Hzv&A#-*7JGgw*gPv4JcJ7`~(1fmgkt4ai
zIZ(v&Qq>$Q2_;~y5B1by%eejhou7kUMnh83%JHURn&L<i1#J7XZbb4MU_K46-m2#^
zl2IAgQ~y`Avv^FU7xTVA0hlHz)zG`9IW@Nd38VEA5OLKjH;xlW;cJ;_?0#O_a|BQ?
zi^n&=5vmL9JFILVOv~O_bRiAzlf>_MloK&^)*j+O?;-s8v831Ik{hSDMt_5G!R$uO
zskK|^btM*EzN%85OqvkO=Z42zm|m1h@k6Qo9>XhuIF<^7m>~PI&4=~*^dEh2dX}((
zTt5g|M>@ymXVVFtYdjvFQPPp7?_*U?a*eTUjD8`4rt37wJ#*Ctu6_f75i2bjPqa|5
z&n!6EVoF&Dv2CUOY7)+s^E~X1@1txFI@PP^37&#Q$(y5<O~J#wh_C1W7?(^x)LTRa
zYy@OD%1}UDWz??=gH8}r%AKAaS!AY3Y9tnx)QuX9GQ3rUeMg^8S9{f7$L0}ZzX?c}
zLR(N(cbo?__U8|o(K1~2_w9m+4YG_9v*H5j1Or_XQu{^g`=C<Zd+J}L(G3BzgRuPW
z13jF{L%h*#%ih1Ab}UBV+2Hz)n%e~K3Dz=G?2hVtrsk??3}-{pT!YKK9L#eoer|)!
z#NF_ovhCTnTU0{wRuU9HPV|6na%(W#3cMcfz=R6nhr~$MD^w3|R9*@5lQJBgW$rCd
zoH-{TI5&utw0L``F~(1FktqSdxUQ1h&-<A=WS4yO-VC8jP*FOtF1l-lK{VW%Cz<EU
zh$w)jF<{MV2qc_PAGLl<j}gidB&yHjMnSwd&25X<wLRBT7($9=B<~?ihm*~=?bQHb
zrD9QhqLV4Zw@c|ubnQGCWz;%RK3SN(4siZ$1Y@a>D##N>258QsKJk<+Ek1FlE=m`t
zO&Vcx{t}_(_@d;pq1Ou&kBdC4)DR0o*;-knW3I0es#?ZXs5NWnnk=}dH`O^{Ee=P8
z!`&{&FVVS>f9#YRFvwb2>9<lGz6xlaC8kZFkKb_B2HT|5;a2~zpeRa72Ow~BKjo50
z&s-c%Jz?lkP<WDLdCZVginF-$A7~KVzSbklNNc}&R`;&qu_I*SAq36URuA&A2G&AP
z$XlbKt0Sg?tet&f%1&_EzT56+kl`7mQx?#b<|*S{`T`KlNS=ag<XA-qWZRMrT%yGA
zzhN?kz^koNnp7h!nK-dbe=SAdzgg#c&5xRz4E?=FCn3Li#h-mc6M(&WIa#}1S*DA{
z%`f#?YNJe*!vX4=VzLHyAYB?!w+Lr4tc_9^qo2nRgM#0q7rLDy|G5A&J=QlTVu>P4
zz*MwU=|+`Q=uL;<T}Rt>qE#N7ay{-*!K>7Oxug3O$!Dz_4^C}6lj9>5v+I1c3vp@X
zz+fb9poIF<=K`Y>d?D5}94N>qD9$MSeXZTGc`vGoTs0aP7x@y~YuRw1iuX<YDf~AE
zv1J%P4|mLP!)O$Pd^xko1CAvXSnYfy<t&G>3loV=z>Y`UN?QZCzdKPD_zl}_yxJ90
z*Z2~{Lj_%|!`w9LP@%eZBj^UcdAM4Nk4yxqS1&zm50+#o0V=p1YqfDye-X{<BZ17m
z1+uS6a4u+khM_i=wZ{8fnPv=u(<WQ>mZ?X$Krlq?F)0f8_vnU*x?!y7y^63hAZ4sJ
z=GmG#LzPYtAOaZ@k$ta6Q~C6h7|vgR8FJ)lRxpm<dGFC8&d#4@5c`iFKk%aCVf|32
zYiEr=U)HtKS?&kRJ<G&_UG;Mu_HN96zhlFKv1aD#+`5-Fudpq)+;6Y8B9_F|MirLj
zDxEmlPkG}FBntQNwCW&&9syTg%%)s1zxff(7M*?)8Uf)*so_7&_5r(cn*4Nk1Uc#!
z-E25lgV!q2vNdYN1$NrS$quxAGXv_I3RO=^RRc5U6=k5J8gm(F1emSZNg2aie&C<{
z<7)g0kasg@@UU;Sor!DkP;n`XG`8(Ry3%IgohBaR=bGs^a|mto#0(wL7_fh?YqzV)
z8k`R|Y)=FMP=BJqYKE7wbriShHJaAPpZo5eWdlc~5*Q}@_7V$KV914?-jVF;V0T_T
zv-M0B@d<#`sD$NDxTvj>#wmJtiPt-s#7hVl*fjGhe-pP`RYnIz{tb5Z@r1f)YPF{%
zrw7x38LRXvf@LXO^&pg8y9~1d;M;*A4isFPsGJ<rnd5qOFgYkv)`tU>Lme)Ih2?j6
zO{lDTTCu1g(6~WV@tt(=8n8B{th}caJ23gi>S6okaSz#=Rq0vpw47MJVRqMjA$zD$
z_Bn5UFBL5@(3hv#w3Ro#ew3h;3j(Lws_}t6%Z?agrp#70TX4gl?bC84u!I#Ys}{^4
zTn<Gq!;a@YU*=XEVF3}0xeN%ahE~trE^P{1f<qs3q**}nHuNxIdr3supozf#l2vHa
z2Vj18lBZh%TwtLnWz(y%l8l8pf!LI3NFwg12Hs{i%KiuRk>pyB4m|L#S;2{J)}?Ro
z9Ucq0Q-#n(0Vo<sX~}_(BiZ}d_N&)i^3#1eAqdX^dNdsy*tt};c=0N9#2P~HnDBGX
zwFpk+U#slh+yb<X4Jf=2yD9yL6U7{IzNNqp#{eA4eCK{t^Zk0#gD<41RIk0<M};WD
zY>CEnK$$j(dA0Wpi?@l?KXmFDxAqQOI49i`sNb>_^AP4h#S~wdUYL-3g@7GI+5zGa
z`<j2|b<5eD`ovfS*(;!&(!yQcaB)eaNd(FFhS^yZDv$~tL?q5D%7s5wfe+2TAoh5R
za;v1Q$bRd~3r56NM7md7Oxv0qS5ldgyZ5v|aP(Q`Z>eNSnZt728*#7vxO`zt*a+Qr
zj<lZ3UT`}0q~a@dwOjBYlZIQhlDqFw>1?$4U9g)r%UNWoFbWP9!aysqn0F@u7SEOW
z!w^FvUg~g{Fi&9@5btza6G=qixpnrmV^Ed3<Q~c3cdI--QhE`I!B??+lO;wm!QN$&
z2<pXEdxACjuNjPPPjjcARQlyOQ6&6ax{rD4k{Z8(*r0VA3d9oi=$w3=+J+_7J6*&_
z;l&`Q%V~tbk4x=qelq7b;(3EFQTf9{uhLjxdfztjYt<6SRTr`ik^l}da)%$F9MM^=
z>4+2)ak&^ZBx1$$mx}>q6KF<HN$}uJS`S|JNaeQzTrJ?tHN?Hu?VW3kVqP2%<rF%u
znBOgm-Q2?V1EETS-id*jMX`68zU+rnpb0xBtT<^n)ECe><Wo+)f0>rYnkL9UK4s`(
zlCDYsX5P4twZ4|L(0`l-wr0(Bn>m}<+NYJczxzb>P*1_P4H#42w#*J#+H?rYmakz$
zOH_x%zm>w81e9uwOco$wdOdH8*h)lu5LCqNdyNaDa-#5^Hg6ydMN)w<?yOBBE_2T;
z%9d6e1W9g>SOL{-r{p|jYLu!|8UZ0@52)7EPE1Q^8E|E*zROjr>Wac&`k8IweYyY_
z+>D6D!e)o$^gvP*XkZFLdv}q0z(gn{AUaiY(ycdpLLYJYMjd%ZV_;;rvJI4}DSnV?
zsKCI1!ZJ4C$J*zD6tC}Si*27XboHCi*2e<qJT6wqXvF=TujFY#I{SgN508qZbZcpT
zAnqP0BRv3nTt@>jo{eUoSIsC&=)f?JuXjY+Yf$9kC|rds>n2*IGoz*tVk=eS01CQ}
z@+&7{8D4>ly8#N~@;L;?vicyeK24OfZ#CX)V3vFzM5P44_uVHYtkeP&!K>twa7o!t
zBTT?5a8F%FYlvVh``Oe2QF_F>PdKr<9Cz!EgtaHU@_Mb5J5XYo_G_TJh<OcGRJsh!
zeu<ySQOj8Kvjc_MtuW(WNtRT&vJg3S(oY9r53ZyG+hSPi6DY5&0-;eQR)5ry4Q-Zt
zpQPy~UXDr`^TpgXFbTVODr~dI$4ou%@du;tjVBD_!uD^WRp}m<UwQI`r8a8s6uJrd
zbbSQml8fc&rBHG7!S^N{5_pV|8owf5e*A>JM`A>#zz*v7V)q47<6KVy)MbY;G$|jp
z5zgD(?z>j2j{Y4t3VS9JDy6zM_q3(!d~v|tVthP9f49UqSG04W_`bxGfp0)FoKOql
z2kuIR+IloQ34;U=gWsd&eAHvWo}$ud)JWP((rQo+UU!u%*8Z`$D;{+MpUM#W0+-2#
zxk#b{#D3&hSh7edV+PtUhP8`a0B76(b38w}lC)g%m5RIP96;U7vUc+|KIo%vJg5xK
z`e-Hz%6!rPy*FdOK9r1ScScwE2QvOBtR%E0>=w@1H!WT3-e6DpH&HyJl4fe&T9nIv
zhH>PEB8JM@wk9}lxASzPSK0^U$FUBY6lLJ3z;uRXJ;B9=9=){x3NQ&26VTZctZ$Qo
zzi@eTrOv%qTSbts#_x-3!+SIr68m5Wz2O04Oq`}h6H?S0izR$T<|cu?<Y`La<AV}6
zY8p;^A*2OYM9a9ic3M_iLLX&qqR{5zeW3AvzGW@b80n=v(x2vbi0jowCkVwe=ckz%
zjISkz_8;J$VxCS30{v+Vu`IRd#gQHCwRx>IY~kcL<;Hd0kuW73$5uJ5#^yN040K$(
zp)heS=Y-4?vBO_QO$(>uafFtZ?K5Hi>i0zb$%@kqU=e)m{vQw7B!aLKv9D`liZGPn
zU&k7BB}79}R{?h?1@SHAOo4?vr4dZC$dFo?74Pbgq{sBq8LhhdqLOD#r1p1a&X-V#
z0oe$@dO~!Jl+_eVEq6}cSD4P)S$6@cz<y4XVgWn2hMr_Bs-hV(q(H@>nTH>4JoAg(
z(3c&e8fbUyS8SSQM{BKCr^q(_4%d9#J3!^aFI4f^mrg<J)I&Byg;oh&1Nm`d5YF>(
zy^X<+5YKznk^1ZG6rLGF92~`Jc<x+zr0;c=ZPaKI!oW}OO@Q%YsS}U+wWFk0MLNZ5
zvRd%K6Cp{EK$VFQscO$E^@D>I>Hgu{?0z*QsOJiF!-_VF+ouq@HfT*tqTjzlU5mL#
zA_vXf5SPfLAHMJwmRv<S0RGpq3#{;<A>-^c5$K{inVipQawzO(@t6?0Mfuosco7S9
zRi~>{b@UBgJwSSmN)ccF7>q@~3~H{O7-f_-qZ}J~417wlWG~lQ$PNybx*;;bFkIX_
z3(6f$+k0jb)JvCB%&0%75oxu%ln}Cn5v2w#69oa7oxN0w=><{5Pf{?A&tD6DFUvo+
z;ZQs-R0AC^&{yuTC=KmaOwnYX>Ac2IqBR0<_x`-Y|FIqaWfA>#BL8nJB8ETR|BC-V
zT15H2ZEM26i13$YqXa$+Z~1scDU*3PnE}gRLY`JZlKm)$PCnH5?j_|35S^vpeEVaF
zFU;l#ivY8v0)ai*l@TPpFp;X!R1YICoX$!G%fp6<EUCY1Lvt@h?r3O1U;@&)L?8EQ
zs#^9#NE0lS(vP@^#n~Ff#+~{UG{~Hzy@h3G&(0)33Uyi0ZPW#wN5N9UGp{*wE~ZoY
zCR|5&*?5=ezIUEGt}}H%qs4Zk&4<u)L*o*<bxYmK!yBhd2_2IWttSTkr%Y*QNDPKt
zKkF5VUT5wQ-DjOftanT}d;vv_hb`>jV`6QhC7fXlg7yPOJHs(-`<(V;RFEPxjUyzH
z87Ac+bUt-omM3rkbCwJJ4E6{u%<*h~6p^$P!vTc*SVL0Ij%D#zIc)Z001b!rPDnMv
zn`Io<eMW)=Q?6zaLKY-YnGP^ePx#Ji(ae>~amLq|<ul|zdvY}L3!!VPma`eekyYnp
zUv()eTzEFcIp|SYNDA(X+f3F&JvCKO(U)L3LSGS<7k4-rOPNK$1tHSf1s3YhAq}^V
zShD6Gr7T{$h!n(TRzx6uK8DpVW@GBM#=u<C0CA#t(GjM3F99d&JMY5S;1>rLECE1!
zgP_$K#97g{P`#6(f5D{<kCOIOqQ8+d@Ut|vnHjY+5(1QU=k~y1dAc?aH6nK>r9aOj
z9!~1Pph)<JocNcHZ&%>KQj1efKh2Q$tkjFx$1m*9VD=5*j!Y%Kb%370Z!LB-35Sny
zrQDi#1JXo&sd5iW*BBL`6TD=AmV_3#suMU4?$nH!;)ArWRurHypH2tIj;-J|FO^Fe
zD7rT+a<>rM+uoYJH)PI$DQ?%VmRy%O{~)zv4LEHzJ2qZFNaohDz6a;|$_4~wnNta2
zR&LcR4Q*U>4wK(tgGAtz^5p`>-enhbP#S^oyX!B8C{yQNL4ryy9!wb}<x^`5Ah=wA
znN$)w{`FPn{h-i{)f*{%@j&&y@g7<D{SNVpLi%(kp!#*Xmb>#Son1d1B7nM*Ty0r<
z0{WQV>Vuk>&P<0Mz?QCcG@;{Ltfj8$Tt^A|Zk-SCIS4jE1L`D=<|01Duuj0>slnwG
zXBbZ$-pq2!KhNYd&*L?Q7N&KnP?4gxF}Rjei_?Mc({3Oz3aX+!6-UoN&)n-)a73F$
zCP6tW{#;Dp1-kE>{)Nqak)Vv{iN&i;jS~tctj4Tnn}{x+X31VR;*r#cly-!y#zfdl
znP$|yXbzE-x$VN!fcJNrESS?Vvhg>mj=@s+XRBm)$Y{adkC0kluIx5l7VPFCD??2B
zDe1dh49nJF%G}$rc%>Q+sUHbO?(N#OeJ?`8xcUbG#>14qVZS3nwj|>a*Je2R$%lL1
z1jx5Q1*PSr$#03Un`&qI2xoSK_6XKD520$ph_XOd;f+{26ZsA|{7qgzqu2D4%`x`0
zRny}5o5+QZDJvh;bG1{Vu}9WIrE{}(Cc)^)yC~E@ouQocR5THu@U<W{Kk}1iDRgVJ
zQEijytufB_-=k2|f=Qzyr*)&KrEfN5&dQ}dH9N#{n=kjbpnP~FglK}sB{4}GIBs2Y
z9Yw#iZF`-n%4k3mbcHRa2>J#0DaGyHt5NS>?#~T7uj>aq6z{&Mus`AF+3+GSsJQ`#
zD~4_=+Z!xUeO?%*$=rqJH5TR>_QI8^7ehoiPi-Grxf2&Gx)Q^B-1z=DZPsN#SDEoG
z!9#pCA%+RN)<NHe5Mij*m`gGK#GK!YJm*(|tm;UdmD2B1)kaozS65mFoL=>DO4UQG
zcq{Y_DhMj{I(nvABC-*MHzKAES8@JrxR)i12RdN_r>~?`Kz>Y?pM5z+rU3B<1BAZ7
z*;fYc2uxas0ZOuKeRXG&<tGI0mGuU|9!E2|kO`-L7R#v5m}(_|9vpaOOc;b^*d3|u
z*S0%$rA(pF9)~&LPiKeEwrwsT)I5+LFiPkA)2wJ2&ArSmm$vg5h>m8%<TKC6@!A*w
z<hHddeZwqFMYua#yv65ca;+5?U>K{uElJkb$}ZT;Koh@`(t$jnO9`8C$>&sDyNfCg
zP*+eQGY0_+>2l);sW+7_A2eEk@^K+<IdI@07Ee<FzPX&G6Wa7kyG1)w{U<&g-&O6&
zqau{SL%UDXIR@T^GUr>nLup8O*VQ>s2^zVpOo*+;Z?+Z0xlBA!t@rtsEhOg!z<#d^
ze0fY!Ie_L@G>26Q>y0JAzUPq)S?O_syzYr@IDJo}pX1}LJM4?j>3^xrG{Py<`kbH%
zXNmImmG^$Zl^DD+-TG7liXm*Lq4t91M5zi)in(ZUCcCl2pXeQ4pj3kr@jlqfJu)9#
zgfQ!b`3s&bBf~r95z7#Pb@jb@aWNQZVQ4ImLGH7ECTu+mkLBGUlbS^qtf4T~U-3`5
zpwq&wzZU=6ZcCz!c3RZ-)SQapc7v5dm{rE>(iZ0&?PrrCM~%o~+9Yio>4c#KPLbGT
zg@tY>rsov|0x-*oPnk|0;1@<sE9(JX2@0t(j_Tx4hSh?HalQ3z4T}jB6}g5qaszj|
zxst34;y6F0nGT^MGN?`q5k6%<$He|D^4}q+ei}7*&7Zo@Lguhe)*csQweqEt_kB$T
zBVlc$j7=Nu-*<XdJDNnrL&;yF;GBR_@q>~S5DqA)$G+xYV!5-YN3_MPG2>FHHAREF
z3FE%dYF%@Z|3cpCnUTnO0SH+!VB3k`z?MV6t{2N_0t8)*Xm$?L@H(J_SPrL(03?Td
zsci=)qOQA%W*eMjCjhMytnHYM*2I$II09u3(pi^x?N;~3lcdjTmB)a+8_Qy!3Kl$3
zG3gm;Z!=O?D#Xb>F9fSzvr!5jakHJO<5l}ma1U{cy3Z*CrJa$;Rlo{#tWZy?3?&eE
zzUQcT*;Od909_avZTzB13&vA~Su0}Cq`dtiu2SGG%Kx1xP;cfh>ke6S^r3~YtYrYJ
zBMccKa0YCLTmP_aNKA}@8re-ACQR$Nxr(BU?8r^UeOG<IisfrC-_0d&*H%3?lH5MH
zNg;J_IPqScT{2rI(Uvo3!YcBci}>ZdoPgRk0#bQRIE6L=7MHtR<JS{aK{%<coIIx%
z_6`rl_((#ITL(3f|GeZuQ%&~~yb}pZb_Mz>ht{X{{8t&dGCG(lO022UdPlnthd2o7
z$ZAM;2l9k{frq{#2Tc80ypUkv`MtK}9STm;n6j0O_-utyknELUYnAn*pK5%@-0m}6
zGU^uVr=_01Ljsf|7<Ekt;_R2_3p2{k6JFPVk)BIdMUS;%Q4Tzz1u*>NAG`>qgiK8i
z=(8t5na}M08T-}3mz(en0+5_G`FfrmPVSW0pgk$Vstm227q5vHWF}!ff>z(xikPXu
zyggGRKnu7@l2zzI>x=KKec#Kr5gi{GZhi>-+PPtROj#g)lyr|9MClW5zt!Pj^^|VE
z>&tGnQ4HC^;X%vSAw!)z7Tp}qjSWwr&EKM=;XkkhhpRLf6UEl|mdpvz(@ma!p@=Vf
zCMr!xLwil|Y5jm`N$#KCLINZ&JF6GT_y{Dkbn<oOg8|uyCQxHzQ}XV$P7=i}*AURG
z=5^{65<BTw8V&$-U))2R8XTDUMp%pi)J&{#ubMKl+|9lTIwkVSg$BU>DWSX{!hv)>
z+qX^YoQnpyLf^st9-JkCaLs!kFFE8uoC3<S@Qf}@r*4RO+8R@tlcuP&xhF+2UIkiq
zKtE!-rCgswHAM4!TnWanKBf0@bxdC8L|!&9&wgUY4D;yvti;+|QUxjZ78VY2_(7@6
zm-cpSD2rs~Rn22TRzM1YEa-`q1>Q!#Ag460I;Kn$g!yMt-ZXEL^r)irbMQV^{(_iu
zK}p4;zQ7RDkxhf*XkRzpruk?a-_@cwAGl%Iy4I|XoBWM=r;oMQ>%nZj=UWT!o>*L?
z;Tuln7kN_VkdJ+~7|v`$IY67-S18nq5D5Lwi5R4#a}T=Tvp59Ff?N>1&w{qkG5wq^
z0k(ZqxwY_=i@ebAB^Qo46u_^W=aziI$i@W!Y}Qpb6;)qjkuq^BZ>qObw~6prAmrss
zXx&`n(HW9F=a%6QUjOquaohK6ewdO7>A~K*-nZrq@CcusQC2jPQ{tm2Fs(iSRCW0{
zwJHW?a832`HW;?#aZV;a*b<@R-`*9(@6nG)sN*#ov<o53*l5c|)zBnO7`<+ny0j)9
z_r;ePK&5)!xzGtqvSjH#`6rD67EYFvo@jbc!OfKE6W_J-aEEnO(psMM$|eoV$Z%SA
zf#?|Kb{Hi>dbp_lj0jF|C@^amg(-WEl$>*@AtB{w-c?ktf@zS(g_!-rD1E+z?QQUr
zGWe*SH$&xBpz&2C4??@O(XeR-nF<^!-;rAgNc5*s!u{wS2g;c`YO2KW27tFNDiick
zDYE<NTUZ9O2Aw`)BJ0V6mgV}RBPawDAgqpD9R}}Ni|f5WgyF8}#Kop8hyG%9Jz`F+
zQiRlZHkZ~1W#4t?(qZeRjM{UC@v}vjHba&3$U00~I?4MaPe9&{$f%I@_6>MZL6EBs
z)GXtHvXf4y77c7JhKD{t=?91~T6Ujl@anbf3jKHngDC*_3u&?X>M}FPHg6H&de`b}
z#MVUkprSI*tT^%r{v$~|3nY6mR$`g-5gGy;Ibb|to%6l@-7`R~R&VgG9D*x!fdp5&
zQRT~(dN3F*w!Sz&>z$RqqBoM&89S#x0~`4*5KP}daRs?BP3KrX?knc_@D{K_!V=xf
ze*!$txQsThzfK@~C&%FOkt;`JnZbTFOqalW`*axsx;9keEW@ADA0*oEn&Rm719+D#
z2!&*VqY+INPryIsRC)DFcDGd=S)}dbCQLz0Gj?2sYv4UJr;xLXRGGc~nA8xXu_tmP
zqUi0|BY?H2=L;fZfC3*iqDD!+Hlg>Q!;Xp$$Ou#M_ta~PEknA<5)K--9P+_8+^gxN
zBcuFqI*)OhW-6b>4^}t~_x{#7pU@mXFe#N&3na(wg^iOGue@7PsH}!8ea`vGxEAOO
z*kP7FcY(B`(}vi<xe=@%{gL&Exk^Stt-GWV(9~SmWuJuD1Fw41QO27+K%V2p`(>Xb
zRT6AbBJqiRprdiQRJAga=fN?;4uW(>$dLsCGqGXhTk6UC%Imw@&|2>TzHG5me+7MR
zduv0-kEKin4eOm7ED5YU9${o4xE0CtREIL`bBa9pcCB8CUcJ@y0^s=?I2VqXPY#hv
z@!8s!m)%J3$Mp_Rs63Sn?rVF0+qPuRi}8@w(V$`?p?H^0oI3Y3{)L(fpre@%>Fc&?
za_*u+*e#B1!rcFnFvO2I{eb$5xhE*)*>Jl7o4Ry+D5@<Mb+Bgh$)8QmcyjvDF2218
znuE~>c?dv@wGJ$MueI<Kzy4P|w>0OwIpYnokXwdBOEX-6TdwS&pj0?|%cr#R6TL%5
zGKf1p4aO>C(is)Ft($^{S3!EEs`bsH4qQ4D1W8lQ(>Be3-a>nuH!D7(<-5DLdj#4W
zV$4=`-M(Hdha#UT_#A&Ay+~?|qR({>LNZ$3p$E^Fs9gCxmDYmOTgGy6Eb2lOQbA&w
ziAf}@6z2ooP-SfkTg$+SlkYrv6kp+JFdwfK*XokhMn6b7{1IBjHge(+7I|ZpqfDK<
zoSc|_BG>Bucb{ApiVW#;Y!0vokt)SD*6EM61#qU_5|FF$sHp|W8N9G?tQe#X7hCM(
zLKS!N1#0dAR++|!<=9w$Qf)BDdSx|v<XNTXEXSCjFb<2k$1}`rd;^j2Z>UN$=7AAT
zzE0M)K*#)jC@o-I3ox|V&~wRjQ9V(B4OI!{b<-@<8g7!Vd}Dik;CbIXS2o@zF(7A0
zYPcW=2>z-$C`C>U4G{}7%&s1O_T>1y!iz=-1w09L$SZowYS@3fKS1_>6!g#b*CulQ
zM?nM>Y5vC_`fn@c@|D9}-dP2%>rjFjr6;)3!oGITv@Mh=T5-M!+O$kb-bBIbB|WZ`
zX7!uf?)y1D|1kenH2r1&)xT`UKl-ouZ`tXn#UobJI`PoqzkiCW<4&$a0b|H{<D7*1
z=WW18j*x|{a3e)#TJfhBnOFHRj6D8<{HdP%7yGaNWi$N?{Ac&yvWsM~)nj}2;$X2+
z2M4e3y>xdl@ZENu#ZT{R!YIBaKC```;P$tNQ>#*sXTi)F;{NjfY=77NSO2n^|LDKs
zzh#HUF@H%8kkwlL^xMYQT(A0#*(A_ddLn~n&;;X(y4|5odlUb`6x>%SqB3aIeO&wp
z^7lLc%l@l>*(`tbU-93vqs^Ofx4pm{<yZOj*9LD9=rbe6=CYSAQ{6F`fqp#`HHq5<
zFdksXWFedOpXW~G{ewaHNB>j)qv8$VKimIQ-cfw~`$S5Z|7!w$PXGXY*Z+16@taEq
zahe8A3{xxy^W^dBObH56S|bCQH4G`PdA~UmhDQ9d5&^1ww-vuQhX|5d|NdQ)1V33<
zlO!Ce+hGL))dl!mwfeJ-asF8F=wx)Cugf=8zpZ`&G5ZZ|tPtgFwEGSOAJH%{920Ww
z3Xt8?EBWQB!FeM=jt~qvuiwJ4+M#BL`jnDiYbLx^;)(2LRhs|=l#G|4dJ}|cK*824
zu~?UJj?T>?wUqe20r=mhCpw)(*eQ}eTB!i}|F{lAH<(~g4-3>DJhiql4P2-|(6T}(
z#PS$y&G)Q>^gE!bbZQ_SaPV&9EN1~c*{2HiFI|<%WBa`~HUPesX{(6eB0<;ASLDo>
z6}$i}=9`rC9y~FzgI@5-|ABtKBG4%;eE*xE?zuMzAwP(d|LmwFcC+JJLVJ|(>}n7@
zW<Gpq!MX_vPR19OW#Az#M;iHP(Oyp?iB|Rfk=|pQY$t;krI_hm-1a%DT&W;&G3$N?
z^w$JIJReMJbL49+lUf8Ku@(Jy`nI(Gr%5Pv{0L<&6Mn18EET~sMU8W=Ga4sXS(#~L
zX^TywxK@0Wl~Mt*@kf+(4I6~nO9~}f3=X>}j?f4gn%Y{n{;=<f+X|B}IpCr&er%B|
zXw7U6XPId}b8$dmTwY``i<S<9h>{=*y|j+Zq#9lVG9i+Uw(BmlQ_n}7nmo9&&s5sA
zZ0E;42YtbNBl`Zb4>}%_xfX4!1YK}nG<0B9mTyL0x(1Zl^HP2Ury8ENSEqoV^d2~g
z8)Yh7{-Vj?m;u%3c<o!}?1yX1x%K4!tSNlfy4#gn2uuZGbt!xH{Bz%DC|wT6pw6pk
z_3U%4M@zobz@QQUhzC2QhJU}fN7*zex3uho4!bTFkgTc=c#0T*8lEU;gE22=;JfnS
zcuvQ$Gy;~T_ygBX)XdvZ8`xAy+-GjC`k6*97!&s@qv3la&;~A^Yhf8~voHl7_44RN
zmaV&l`Tj}%{*T&kICsN>n3St)8rJmp0Iw%D_`r19b>CjecQxgZx>|d*FT<g-t8<(}
zr54V1hxt_tnHn4=H%N`005?nOWBc9Cy-WMRHo&-RWMRGj_8tOfqn1I=J%9|aq<3ez
zB}n!$OnkTuKCVp^V1?rIMZfegBQ7J_FM-ke0@S;q#NK373%WK&|Ie573JIC1q!}#b
zgtWrfn)sNb)9Uu4@z6%@Lr(kEcv5p6|70P>bW&l@ySqrK9IZ%@RAQ2Yx+)iw#=3*7
zpC70~au{%Xu%Krsz&Qa7waZPf(B-)2We$kp3zg#|E4v@gh(zLhu%;@lO>6#mdud9p
zdPpMT=+mp8fHcr1x2A`UdZ7-x)kV#O>TY5^r8|rA7{%?6{xH_`$S`?q{%*-o_EH%A
zntXDFSMb?f*<XvfX*W4iskbHY7S2+53yd%TL>QS;(=lQ9D8U`#f@kv=?opM^P$xSb
zCW3iQx0<sW1=1OK?GQ2Zf&d&52Vm#FpGgiUR$2;CuPwuTA{dA>5o>|SWMKIQMxAkU
zaq1MTh^^oTnphO7bc5d=Y~-p~c2wwiDM(8)2)#4k^q&226Frty_l6ebH;CSqT6M|G
z7X!J~gO%j`5o66tpPPv4kpuj28mfg1Y%V`nj?skAFPet79l8*OG~ng)yj-e9unGNM
z13XPH<8KzAVbVQ;UA_!nZXnBaPxS8mYYMYU&<e^!f6O0G>n@=qjwazpF96$<Hi{HL
zp%Hh}rdeMWP5JZ{I{0aiA9rv**)jW2w_+OU)n=Y2Ml_@JARh@a-Gdo&6cxgLFwN+l
zU2s5Zv1z_j<qVeK1~H58#SXA&2&p`-|L|-Ogzq#d?Z}^tCL~IFDq-hlmKi#@>8?a~
zaK1R1ZUxajbUQ8X95=x)N@51S2l9p$a{@s>MPp|2$`Yw&2^D6{{IFrF5?*z)j|;wU
zP7j<iS)dhUpgk}D1<q|OOnu@Y(&VOWohe&M;(2v`R~Ee_0YuwgOT=L$t#2O;pW>wv
z^xJ|J1vG!HIQFb+6a^F`W>P%x)I^h<Gg#%Ew@e6D6g!(V!GBY(1PmzLF#`5Aq@b#V
zc8}lW)fchMe~d!t1j%;Otl8^lbqSv-bHwituSxcJ-bw%wL)u&{gH2!=t7Nvr22&d~
zB>)cvU^NL7gk3j1jMjPQwA)<`k4958xgjGbIM8<-&7DzBZJ<wz@0zVwIHcHXG!$*Q
z%soQ}5+OyuI1Z+v_)}93zSPm#(ZinOq5Cd@vT=Zkh9wrdbgOBx5rzdkY>xRj3*3P=
z@nJ-mhilKnZ+RIPm4e}>Lte9*n^db&RR#>1wZ6G1ag8?NcO50Unv~PIH!8kPf;(6F
z=8VW?B>tCMnZTE<`F443?<4h8jrCSg_{Pw5M{7I%0t+A62{rQ<RkMdQ5uv=15rN;j
z(pHpe_jx}*xqN@XPZ8)iwFTSRd@STrc{{SpUD*x?dU4AOM&8gBN)Er&lGdX#!L<xd
zGd8O|C|{sM5NB!aiQ6i#0=&tqT2fwQ>UC-ycd1;@c#S@43Wz_5yaW5Z^@`v3o>qG_
z7l_hC3h8T#10YFvH-_IlsVYOT^^!$i1N9sbnHqQ{<_S$*vM#o92aYs3_tp<-y+wZ6
zWzO>DDqR7HcReG3oq{R0>9M3ntiKp<YCf33pf6M@yvZ;5iX2)fB1IGoKEJ)@nw@<P
zh2ZgYUcaftNn8Y7N)ZoXfioWKAqxhFs~Btp+cYWp4xPfBtY(}=(`akV@@dO1puL#(
z^)sWzosP#BDgTfSJ8A*p#H73=-~;WrjKG{z7-2+<!*9XG(bL;i+RPIa{I1JwlZrOn
z5%HU^Q8k+9<zjyD%|ODS?tq&bph5S;K4k!W0cZ^w1&gh=N`P|W>rxKVc;}=~=02-C
zP@t_Iu~#NaEqS6B#8_Hd03jRxsrN{Ph!nn;QWqNDG)3cde8>Mp_||l(g2yqSDdPI#
zbMA0DwlE`hAPc>#B=1G&@Q#5SZQkA$`37BGJbrh@Juey5l=S=Z_gizk4gYal&k%z&
zxk)5%B9usN{)O|#!;o-?{%l4nM)EPYwdp>J)&x0=#Ty5eC9Y)jT#dA|Qij?Tvz_=3
zSU$KV*2VE%{^db8bw&^wZ43$@#Q~y6+_`i&8R@<=0DB2ZS<ZmXQa=r-H}BLH#_do5
zo`aIVY-o&VghsM_h}j57^?-cPQ>ophyiCwYGpFxHB<c%)A`JXaAo|jxnL0glPbYZ`
zt-&WUR%pXxP={(No#75hIkR4)W{OZwiW^{(e<;rtd8(*T^wOXU_T%ejpv_7jzO(dU
z5nXM$jdEpf8H%={{|Y^UpMxR$HtpgVnj2#Go@D$pvWhf3aWQRrObik?;F*TfvvN%A
zoPTG2n%FxFE>n*y+OXo44gNR=2n++}g_>nZiI5_7#G)e)to;)CXH_7(d0zZ?qbLDe
zL`36`Fw1=FCZxbJw%X9#v$e$a0xX3xZ6Gpi)V*7%uZ9JQ8NQS?8E`;l)n+^GqcqQ0
zoGT^`PQ6a<24%Cz#}#0BIK+B0(gxS(6Yw?!N=_}~ctHGdLT3^NL2_R~7A>G3^Fd6>
zuO{SVJ`xL`v$_|C2>itbovRdsB4<_d`|WB08wY`!b<Nf*NgJ)^Z&+3eDFDRHOR*AT
zwWgSSpU1gNF$db8&2!jZPHD(7w-v>+VfO5rdGOKo*y5Qlu%w>WgFO9d06X$E3=A>q
zOs}Y<Kc!?g*I4GwMggixXfqsPw}Sl2)hmi&!1~!qBTXW!zeW7;48HZ|HVy@t9Hl;n
z0rbJPMX{CAGN>YxHO+n)BdlCSMotBDSvllmmqG0YLu=lI2A(9i5q|;5Q=d(GV1pO`
zS|*(5flqBxUVU;5jkM|Fi{vSBR7}<rF-Qva7zuWjtEb<GaX#+|?L%k6F^Rs%uuWQp
zj>$i>8zZKc-^827)kkluCy|HX$n5SY?`vP{p%rNP{`n(aMZ&tHVVkYn$^p8c$+$xX
zuloio6oSCF!C9oVb7BHxgHD@>2V}4>28UYd`Sdrvlduigz@YY|%O>M=S!08ehjzx<
z;!dd`Qqe{MNr(4$v`~`E57gf+ix!-QA{m(2P`?c!QWQkd=u>I|uWI{HJNCR;V<(6<
z!{|Qq_X2WZZ(>IfJIj8u3p;vMxJN^|@COov>VY2KWgNi;E&SlMQ^KKrsUD|oUV0RZ
z3&v~4Cgu<Lrt#}AmUlE$Zz3VdKixS$d<ZY~8Aepm#euX_m>Itat{zshq5jfH4XQs!
z9TnLkuy%4stpYfto{qOEDdkcTj3_m*tSz%1M|ec-7x!;N6MYu-Yx#*&Sg64*&)xgg
zd-)D~*IT;hGMF2$ea|h&A<g^Pg{Y6qkaqxX6J-ad)@K4T1C((PpdFgLs|0Udf%PN?
zF-&<~u}g5OsDESg@TgrCNt5G#nrR@(Lj#7iPS1=W=6yXJv`N(#q=w#CQGJ%i7iqQE
zR?daRFy-iyhXh=hsiiQ-5EA*QZNY7@?@x2#Vi*4Bfk3tm<iP^SVP#*p*(nhh44b6<
zo&aFz$$J$yZ$GKW*;v$-?t<4(aI-{kd(|`>JQJvQHRuUMf)L!_s?A-kW?ll@6gq;Z
z*tlwQ5E|rZuDBJ`;IvUggoP1QvQFF+(aJ78)cRXzhW6D(#0g#}R<v;QN;DQ-y)<z`
z5&<!8WQvXvT^lEE>W*{i#Ela$k7gfZW0OHwrq1!iTWTV_Anypu;mM2|<(hw76KacE
zG#fTl>A3$8%bJT!51G)YYV`vV2sL9+@Yq*~r&I+6-p;VHtnqnh>e9=m80LBgfUkN#
zJLt)U#4%I9AbFrae-b|_v_zy(92KykD>W;us}0|5mUGe{xc3~hBgeHW_;$V>tOOke
zS#R<q3~;3|jRY355}#}a?58Os2MLD;sy}8Ku%Mr4LqZfBp&LHkwo&*~jkxBS)8n=w
z9W3sCYk~j_2SG2NF2{o<bvX<!K1@__KC_YwgT8nYEpzXWv*0-qENI_!>0(d);9@YI
zNd08Pqh5oAKx@u|@Ni%o>4}WsuOelc@MelorWZ>I=TZt;2jr5gZRl2U$b-;_45_N$
z9hy**f`%p@rTobyUV3!s>QhAU60HY6y@0t(Q7q2J6R*R}L0ELU^Y)h(YBlgX+Ks-u
zmU?f~Qu;vA-kXk$t^pWkfQ+o4oh`J75nhwJZ;gy7ps}2dzt4-#t2XV0?Z|wix~Jz!
z=ACC{`*p9yG!U-}wa5edYViil0hwK}%5sSvu(|gF6(!!!L+D8g-d@7O;Z3$HUMZE|
zj}VlTXZRWb>Cl3TJ^E8h_PA@DdM1ih7BMSwiY+$aQiAA{(#ytGE8p@;dK;ow0g4uw
zCn)?PBLEFf(D)I^DEW7Yy(a2@cN^#SH+Zx-M*<fetw)O)12o$W(^Fu4>W^}{&T}O(
zi-zcNn82uST3yNEL@z*)?=btVid#F1*QAY?x2YeQ)I_~ecA>%XJzU!Px1M5GS@O)W
z_EEA0-`m3@Dc~1<28VUvoKFVn#<jIad8L@ZI78n`1xR`6vf|E|snuu8{2CmHIU2)T
zpV_xcX!d5+$Gjra8H%qfiB?BRDVKIkeXd>B-a_~eqdlxxn%frVj9AyreDd>=6kj+I
ze7r`ilwki^EFNnt-X46V9CeY3=Jb^w4u6T5+?T8S-JAuyA*<8-`?T1(>a2t=R`RG#
zu4F)JW{{!bDCNFodnWqn78IYePOMA*Pf_+)3023y1IM+S?Mp_q@MWOfwt546il$jT
zJ&_Y}MzPSzF&Pgdooa|YQoBcU@E9}8#{d|wV%L>k?#;Tj5f(O05-_6ujaxCoqt@A+
zO1n$TZ>^mfZtm*NqHe3^asKB4n#c><5PCd9gYYN)RUnzW6F$R(B%Y~|_!n}WzT!(I
zeSLE7rOGgKzT5-b`44<s6g>Tq-}zRt+UrLB4j_%%jR?AWfI$Gq^*N$#=aFqFZ(`pH
zwCEuB<=oqhujoQ_9d7^`+*Vvmpd`Q%A~KK_7h0NZKYIgzY@jPffV4>#ft?CbM7Rv6
z&8;F>VDYag{>a&}*tcwZ&a_~_YS$|uh^#*RQrk}=v_abTbts}}nBxd#p3&eM`3l$s
z)ILZT6-VWbr#Q&!?O&Pit4G>C3O)yUySVl)b8$w`^DI`3nEBP*K}u#)I+-F4Qn_W>
zvFZS~*f@pj%7le+PJ^fG2Elb?Q2%ol)y%v`*D7N)KypTmb~?5SV0*&WE&7H$kYTvs
zZnqHhx52J?z+8{?=HN`Fo1cYrY2A|eyH540Js*bNQfhh)&7s$whXR<hE-Guy+Fb^n
z!vV}BbhhN9EOp6SE{iYUM%46JYh{{=8s==y1NLqnr|-AcmIiVTj5`Cw)>YHbd^-60
zIGd3U#kcQC?GzAw)^a|iuBPZ@C(80CwdeACwieNB=*AK(_TQ$`j-|~~wV&Ca<@GZ_
zyp}-O=&h^rI?&k!bTLukv7tcm7<m3yEY2$FA217Y(HDgMP5vznT0bt8XHk_o0h5;|
z)dTbSVHe@RcRUM*%bvHRo{81<)b|+pH*IkI<i%GYKaYa%r6Cr;#13|`3)jsORmtCV
zt=20Af%c=<dUSlPRsfFGb-OYpJItGqg_r5SHO)=%fJDO+w^pn0_u^^iDRqgJ<?b;c
z{XNTfX_sGGhTa?b-%e(Eu;yS4IQmpTpV`C|HaI1%&3>+DKy}~fb?^K3EG-$DJ~mbY
zT}DvIVjxzE(Vr1*N@0+M;%u(Dh^1n0gCUbArIDDGSWbbYu`~FL*0f9N#XCp#jeasu
z@ic7)!px~;4N2#6)znE(LAE<5s$$_JyB1b>+$1S6PbsY%tzCr#-V|kQAVU$%>Dc{R
za*ZUl&l7m?8r$Hvp3aSZqdfoNS5w_$srwv4P^9CxmkC07269*0YT-9`m#DZY+5dA1
zV!;!@5^9pU+x5eCYWf<)bpk9nBJr`#aB>WdgzoKS88*BKPJ=I;nBeiD;|BUXN`;$R
ztQ3}th&df|*_(samg=l<$0eXKz((0x4vRK;Qn#;Q=`-vIL4$mUgc**Z;F>%;BMw~Y
zh+WY8AVLnaE}S&$qa16)b3DVxhG-_2Wws^w)E$Px(91*3>A>nSj+k-JQ$9auls*mw
z49V|2VVUi{UUK6^Ak!nOt1O%zXc#&6(?Tp?4IrQy=4dM!zU4(TbfEa6xn+b{Xf56$
zm+fipA!?Lm_>R)&;0BL>i$9}k1L002P<#}yY0Ef-c%Q1NK)*41eY(v!5VysR!>GPw
zjAviX#%`aKKfb^}V-~N5V=d)IUqA1wgK&9YjmF?arc}0|qy9#6je5p*c4MU1q23j&
zusDRFJWG0`8zMadus`e@Oiw1CTiT+TS8JW>q=CXEn4dA7x%Gjp4=?2Rfsttudh!ya
zHqCmsaz0h7*Y`^nAjIlQH%-snT4F|B)&>|1?daGdzM{)p3;=Ufh1R-77~n*3n8cTj
zmBw;PcI7aj%-cbla6oMur5{#+t5Bov()B}g)gUll8*xUqO00OZJe}HF2{A6BeYJIM
z&DZ@bxbm?Tb)hnK*T(IOp`<brj%iXE5xk9XxG!{}*T<1qY&9D9=q9>|>EUJ=2cbk+
z`0`TYqCt5Foo<al>o)&$tTP%;8|~u9D9#xkyHE8MWlVWhjr^xoOPN$e@P0Kyjxz)2
z2n-Mb62_e>m;g3cJ9?@eoaD+DpUFelSeJvyVuWHh+^W{gx9wYCoC02>q2pU~XD!Oc
zM`^agu&e^Z>-WxASlcUN+ItrdQ<_5SX!7m`nb84xB;`>4!{lxFjt))9FT8V$`dFoy
zhcC3`?Pa6pgcF{_SiH;LptsxhqI?veV<&`_JjTqzlJtgw3Dn(1K5N5Qic6DZQT0>w
z&H~&S-k;>adwcf*o-;uu-qB6Zo|Ow(Win<>O%hAKy)_uUyYOvUAQMDiO!M-O)WX$L
zVVO*111Rn609;_<bhj5C`+Ij5&b+wgSIhe*j?rBSv*A?!cJ&@}Ry4?LhGTF=928%v
zXex9~-sr_>hO1vh^np1*m=ji^vWKBqu$&)-EZLFt$&hY@bz2NB5rzRp-XP3W>6#XG
z6JgjWoCXnr<>k4z7VzgWA}_9wzG{+n4FJ4qZT5Sl!bH4Uq18sK)}S!$Q1-A-#9;1%
z`>wi|A@l7S)||#cyF}duvj!V^pE69@$e#RPX>YYoNQD?pKx3^CW!US54NVv1cf09E
z+$289#y(XA7cy9TutP+tm^_dgpnP4G{-mA|3*~OelHJN>ZtV<bNP{j}{c6Xe=T=dk
z>NiXISd;`~-Gyf>?pyu)-c2Wl>|!5R5KmDg25WA|OJp(xR{EZ-OD^@lZ>xlTdOC-i
z*4@~_z<^q`2;R$3lL@(HvNq?&b};2Ev^*6!^WlmVxXYgc5c|KvbhFg;Ol!ev-l3ts
z-TGKPjmbPBixq#QMIG?jSOTS{xZ%Dr8A;PC!r@#djqaD91hUK6CBUwx&LM}c>cqy?
z$Q(cBKdMvaTW%0_MMFaY;&#pka>3IDrn#<z1QS_#)l<}>$bmxCkm&Rj_B5QmF6tKK
zS>gyvyHJvJ_|0_3CY9vD?1Fvv229i`(?Q6`rp@)(vGq?>Y@(mT&^!v%guY6wdE91j
zQTYr9e7Q|^dxrfo=AU;0sl(;${bP$v$Cu(I{-ENB<BYXH)58g*Z_uxY#!c%~N~FiS
zh*DFEUPg_4RI_)!PWHx?w}M^K?Z-(?Nx=6i2B&g12}_}fsjJa;girM8i}xHNOb6Tr
za|dqQR+j-?kOFE(4xjGeeX{e`zm}t}c6~=el^^7(=5~66+E$N*Pw|G1?coGH5h>Rm
zo8%yYPWgn|=fCfN@KR1<704Z}EhDG=Qj^M1pRF*tZd(Xx8!~w<<bF*nqhG>Y7;lDs
zS6E`eSagY(xsQj~9g%g4Lw{9MQvQ`09Q=O(JwU?0N7o)KwcA~yO+qKm=y95xHyq4R
z_F9l9!$2gUWcJ-FT<q!FC9AoR{9+CODNX1PqMlB&adz$R#464%Q^6<J+x9aghPnBO
z90CQk97VuK&sauJoP47C+7AfxAi56Iefbi4j#iq#`f|=8-e;q&AK<Xlw(M0voETT;
zlPutx7Q7<2hH|u+7sL$ffoG$r7};aA&04N;senxq3pXjBp^9klv`-8D`g2vm0xXb(
z7v=-40tJsi%E!VOx9KuAT+8#402`FVyl%e`wBm#1{V<~*43vm`O9m}bHVi)!sGSG&
z^^u~u9on^=dpqWL9&_2y>!TGBoY=^Z-ic+jt=_W-DcCmFplSTPjKVx+Avu^my6&+7
z?@b@;?&R<5x<GXg4e0uDMgO;ew<ma)iCOM0)zBfOk-9#f=%bus=zB%`@<^(a#c04m
zF8B*s;ws8ySO{Rp<=%WR?0Th%k!lw<EW(2ET%i4ybiB?vKVd>YoT`Y=L?PbYO-q$^
zvZ#%%65AijHLX`3g4%jEEC0mRogcwmZ`KB~ED&jq?Y}y;IAEn?{#7`oXML=ObMUQ;
zb?T;tCeXAFj|_g+Z%mZwlC~_hzA6~@<<+0>Qu<1`(;AS!{MPF>Pdg|@?DH0B?1Sw^
zR0!c<4LRTx7Uvha6Z**N{N>zDH`b7uS?;KLk#V&MOsrT@b-3iH=O&rN9@*|kF!vFT
zPI?-@m@e=+nw*Ou`JuP3n3vQXJZW1ydQYI8;f~;XWs-9m>(z;E(6~;=gMGne7un5}
zAp`9k1K@sH<h^LS76$6xvZ|7_t#77*nq29gQ=qAjD;oVv8t{afFcd7}rypQ8mC{eR
zNY?wa^v-2I^;Fg6RGr0g*d~^PPWQ$rpqFYzOne-$UWCr&PJ7T|7JHYFA@JS=biS*j
zSah27dcdx!G@q8b<OGGI9=HX^2DIyYx1s9S_|HmuIknDM;g5oWJl+4dO3D9n&Lx_)
z6axTMe=@KcX|}iOc-IKFn(f*gq^OxaJid}f9tAo06&jwY;-gcA=;IwkE`MbXDo$TY
zyd+OTxw5WhNby4Gt<>Hf4B2l={XI^V%g7x}7^T;jIj5@!$HpB;^4P3zFR)o{_tdp&
zYN3Yx&b4gP%3GLHf=9DI7Upl@ccvl)*^LZt!S~do<0dxjgiH?4I!m~05xNw~HpZv9
zKbvxKqBlKNL>f%YG?zUz{+vILhs5-okR^cK;@0M&2q|T!#sGPvAm)CPV-v8MI#dOc
z-GCTh8Z&7b075rFI3K7}g%n6ZjMQJhP-tA;_W(T*0#Cn^LAwe%X1a!lC{=BD-oA#I
zUEB$L^N)5fA(lMeeT<jeKoZn<madOK(tlF*Jdi>_p-BLq6WySbAiWzAB~`H>-AAG3
z)C8mp&s5Z`kDLpv6~<D(ObA!JE%{GSMSb^z-05eZTqLA|?3xAJTb{mwMGoeS))1xa
z!puivnC0-nyy5$d3GvG(_(QLV&`NMrBHM+6*;0(W<-AYmcnYg|-q7ig+VNaKCrTb0
ziV&Xw!6(`Z8eAL4rt$m@Ym7<~FscN19h0%`HGddm!fo6h6kro$9|j(D!MQP`AkiDm
z5AXC;jOl#IAh~ZTuc@&tG{HSh6ef%73%>xvDe)m^@tF_Z9vjirga|Rl%JZmlRE1H>
z5t^jE%sR*53+5r}^gFv9eAkxP@T{-aQkNeuL9Kmbo~JJxC;D``yiN7|TI=sCAMxhF
z_T-x6f-Ali7!gp@;?;!FpNkMz&K^8&=C3}_!{G)U-`UcYcp$&weLePHO@O2(_=(eG
zL+h+oj`LFOHI%VJ$<y~u!&5+s&0k>(&=&R+sU`UCDfd!hvzgP9K>?`*)|Lo@x%Bz~
zJUPuV6WE1miQm2JMaFp);5(c6D&BDa9pWTF9e(7%G-IKDi~L1t-hul)l1+ylK@s2`
zzxsm|D(jm=?h;*?%22T7X6FhTSP_MN@Pnes?$^-#%wUQ{#?G+8tvq1PL|%hLH=d(a
z&Q)FISFs^58-Yc2SLE3S5C`fsMfhI^^I?zUk}~LL8j$4R4Hes<mU8R**rd6&>fKFm
z$l$apsYkrp2(-X-MUsF1FkYui@N9B>G1NVZ^a8tacHT9BzR}L>HcGIdVN>Ga*e<C_
z4v1PA`r%gkV0Ex9eYnyltABi4BIyBK)+s|FNCtCCAlKm3l1+oic$)+K2)GnsW*}0M
zsFSc60lucgH?E%1H1EMsz!PZ~gTP9x+1i$m^mldFr9g*Dry9oTbogh@_-Qzi7mDND
ztTT73E#etOt1xJ*H|)8{yLRC~L9>1?1vyZB^8A^nnE%skdGZwf%t*nfzEk6AKq4y8
zR~h+kE+kQ7Qxwt+ch0%B!U&=8Dd)wvJQ}Y*qod^iv_dry35V-r=^~!u*=`5)&$~LI
z@}x%cftqOOpak_@3)I1vRG$5!)~>TPX;~i^Q=OJzNr6yUvutor#qsI4@oK3Y$#@}6
z*Z-KEJOqWE;>}bu%X-qfh7+ZUdz7NZ?I3SeR@%yw)m{8St&6n*eZ@Nl2^1c~>Urid
zXHI~Ur<6EmPeuc`G#`PwF#CbGYBlnH<#%O{DtF8gCGiBexZvd4KS@-BpEZw%E4UVI
zSKuqxDHNI3tVN^)=W@cfN6Njet9vgp>NO)^eR|39JwajbX&Zfj0kr5gqxRORaf}zc
zVUMmIkvOZRC1)dJZTN_6Nt@$<IZbZlLAOCizatSWim_FM=LOdN|J4EfbAuJ1)7G`O
zM`*RBum5OJE82c9k-z#0`4jjE>W60&jgZuLW-@nc&rhjzn6lyO|9f#c<&pblN~D%c
zaqdTQ&_Sc*wy2lA#%#dLkX&1iV#C#VXrR}H)RMs+_tPrTAamMUE|ZBs4~(x%6$#8=
z;*Lo`+0Yh5$Lw-P;A|<};8hbf9rLqyxCOs1&l}kaCSkn*6I;AaDbbPC13rbDj$4X*
z&P<r`SNVr|^V~~S&y*~=jYG8y_Aff4$gDl|8#=2m9hwNW(T0m82i+}vZjOTb)#*p#
zqG)&Q@u4iXn2s9OlG%(cRN>(+UMZ6`U8kQs{oG2+@Q#l6Dw9mEy0U<{Yv`YZa<u#1
zti`xSJcy(Fu3XISBz}cfz^lUhZa-MlQTn05tx~sorVZxGef5|gj@i^kOQ!I5O>)4i
zX1hDVLjxcaAG+u3WL4w(2QVk6rWzy#`A49Aq02{MbD#tXGcZZM&<)gS%zCMvQ18l)
z>|>>*gGF!wTMHnW(|rjO(pq=>Y}A8T7|g$;@a~Yx`>2$*Eu61v5$uDP4Fc*;D}W=<
z*&8_9WS3zJ4Z1V1bH=9OBpHm!9&IN}0^6JqL{|W}AZ2~KDUx|`QEa1H0OIK)Vs6|e
zeqf7Q!&ZR5&MUeUuTzsOP-36V@^b)EQVyr0eJ58ib!rf2|Bke}6E)^A4^KblMV|n3
zL`?VwRCV5fWo3~j2DJ>Q1fEcreSydr{b8k=N5thq3VPun@^2l*R+?}WZglGv%+@A$
zV$}8Q1U|X^6MJ43(s)5DbuXQkLZEA_r-_YpoO;wMC6Em??&iSz3os4GniOHBEY{3m
zXh({5a=W9|6Rh{lUZ!l?=4vmJB|K?LW@RKY<`%~q)J@nEE;Ui^+n*1m@%6AB2jPY>
zBO6JOwsXn5&jVvP^gS2_q%!|S)veIAW3OFA9>Ye2XD7VI_rcEbRY;SxF<qHUpWAGk
zdE=54e>qEin865yUy|bu;kL`@tIQig`JyF$O1tB|7AmZtkikseciWEs5D{CH{cA#<
zcEoP2F-+0L5qy7kol2m1gKRQa+{$-Ub<m}UD%jCxuuN&9<FAF<xtS@H(NqKsOcEU8
z*Yc`u{AAt%EsYg!LDMG~LRscHdC9Puj&*GZ@`~8OV5p5AOQ9t7M?~7%nxwToYI<-1
znXkTa+hzs?)KClxxBPNzyXgUcE7DGL@?HEGLi3o1H|U6DdR2eTd(GJHpFJQ~X34<3
zjorcq%Pq@OWpHKoN)8$W7V7=Dk*{y3fnAN&s>s^miA16*&!)s+q#*gSplZVeYya)@
zmkmw;UvGn7Fs<IR`A(5T$^V}@Sfj2sLJ!;~w84oB1!c7pF}eI}iggjkf4D@d2RwqZ
zpM0UO+Hz^>-P$}pxj>9GCGUu%LQ01268CQ0HuWV`gXf>96PyVPY1NR{chpV!#uU0p
zu+vEl{r!|bJ7OWk1njh>DdomN;v<94?_u!!5Yel<t9=D=B_t8kU`DjUH3HU>bo-e?
zkVGyNZ?YrR8WpWVHA@AV9`R`JJkNcmx<}@yMBWGQk`&E3v<tDiD9uBg6IGxcDA>dT
zUdG+hrOcvr8wW9?&wnq(#$fBXdjnOdsxg7YOde|a3TAC?7XWE2q6HPewEF$beB%!h
zfZ&shpXhd%r@jaWG2ylgOr8}Rq9Glmp@u<feXw1vOC67b0yot$%ukyjWym+AAjgef
z7o6Up7!&x){SJ`nr3{+LtesWR3V!6ZxJ40(`LNsJGK&nj7-*<KUFlj_2hp?f0pk-f
zonk?&9YI$8SDw7+?xQTI*Jf5|(T3%%Gq_6Dibxq%I^dCMqIO;Vm)($p_2IisvDRSN
zY<sJoJ42+lCBPS{*#C8*m3q=?(%tk9f-@<VMlt8s(FrDggcOjErLweK)E!0SOm46$
zVtP)2;A9^i={lDPuLo)hv7#%B&KS%7ER4a(6@m~Orq6|v7`+Mw<S!q^@uHdXn?;db
zkqq_}#IfZ3zE-~0-e+DF-CKk|PM*(jiR47^3R9tgD9H_{#GR*Rxj|zx7j}pPXhLxk
zKIrgd;@JZlLJaj#AM3`oV`Ry_hAtbs(3+Nmkp3jWk<wP?Lx7Y17|FWPX8QRTeyZv;
zHqoa94$i6F5e=$Zz&ID6F|bo|%<h$<2?i=w;yfdC{_2goc{~lMDPcc9-OxGc^k^I8
z6o5#S6Lfzs6~I~1aW3O<>LGwM4LoDud2Cv#3!)hAQ&sAR(%L0EwnOgs#4UxLCiGL2
z3b=XiLA$Yfx3d^5#G#_GA$|YChv4yvVxza5*mq^8JD!U!^xOv+Gebnk4K^1}7%W7_
zq84n|Iu8{U@I$g3p2{MLjC?0Jx5=hhv_4FS*JfL!%bqbKa1+RyA96P#;}pVqp!t^1
zk>-V}GVhK2vi11cp8vY69^Cc+_PyD+`<*+HK*WRSdd5F;s7V>}lUez@eTx*kL9tmg
zS0|SxCp1oeKzo4fDhNzVE5MA*?wbg7Djt=Gyl2i_&RHU=*>Z=Z#BW7U!%JIX1YClZ
zL9V<tF&s{jQ$$vbBF5yS{&&`Bkw(c)TyH`QT^x>BdJG=I-VD$*c6@h!d=8N8`@wyi
z3i4$Ad{RRZpjbJIMDeKrQIkDlDT<NEfiz2i<<&|(uri+Dbg}5*GCG0QZN5ZEVIi$!
zmBCve2}_&&GiAbb>J||H2F558%EdPFZGtRXA`caQQ<f<Yj6#E8K)1O0>hHw1<o(zE
zo`<Bo;?Yn0z@VK1k^g;GD_?Qo4vSZ^T{SyC{^0GWks5_fVlA`ITL;A$JY@i;7^3II
z@X4s*XFF`6Ak*3<cE^{k92AM5^7=ooY$M;8EohLQ>>Q&>(OR`wZ)koyJcZfrDFB^?
z1I(m2ICpo|y_2zPou9FE;1S09y?l^6ZTXHLMFl(PyNDLR>Uc~%8-U^2xF49io;yx@
z)z|F{giGv^xvPIkla98W|20C~f{&ST#C(*X_SpTGM}2b`lfOX;PkMGjkUbc0qIGGy
z&{Ueiu>RLdCg+Ubze22yJ|%_4`KT*=PWe`;C{D>uhM>!)zTlHX(hUC*{`Z%tR7>&Y
zokHuRm2pk6|G`g*aj$`iWp63ga#DMOh&u6Yod^rNNp40pq#!(uU#qX@p&~&xxo2;;
z^`HUUf$im}Eu*eJ+z03T|CkNd7qDT!Wky^J`qaALIYq_hIR8-4FW6}gMG%0nGj_nH
zNmO$(JL;C6)7F-y^7kq;BP~|D+288*-kXQ}Kl;LoImiTopq*tu8^Jg13pYsQD7?Mb
zv)`pS0F;bDpZLKu`ju}^`M>rD4v;lCyJVd-dW^9a=B*h>pWbva>ww=6dt6ct1{{=v
z)sQMKLAt8R1fs``v7Y?UPmBzAYkF1Ruh)DwO)8^Utm|v(^oMY?Fp~tmWDS8i+Dz@c
zHz5IY+2%D~^UWWYBZ=K$`^$3zM6xy?E^Iq7G{U7u*R(nMQLk0|av6&IiHI*{UAhh*
zn8eQ>35*66e7XDSUnOuc2^JnI9#KM9oS}F(rki5Sk6*<)IU1NKIJziNX#$VTO&hql
zs%{Y6B1(kcEdlEg<UJ_709_$0^cOl<h7{h##VjnG485)#y74qDEvnsCf8-tR)Eg9t
zmS>&ydqWs68fvDaF^`Vgry)g&K)n)Ihl%|T3RAWlshhej4v;#*i)@|9-0)*t<T#?y
z;`j4}>>0NUNYMMGJ+Uep|8zwp^G+{VkAQ^4wn0A+r&~TF84dnfuZTA}S*IOMLtEk6
z-FEql#Ia<+!^#TjAb;vCz1vFKW;B9LK^kdeo|Jey#7fC<sB>NAH+NLotlZ{XSZ|T<
zc@#)0PqsWAV&x2Qr<DzEg_W+1uVsvYEBLE<iKM>PzvL5hAw^QtxwxuI2Inub?bM9*
z@1D=ugET0UJ#GyK<iw!}famIujnB|&Lve}xE;efN`J4*8kx%E91x=B-FzKW<J>mT3
zeW;0Oiv^}&Hyf~x9t9fvdY9^Y>cV>si%;d1XW#S|4y%EY_Rta=QZ>f}G%EUnJs7bL
zYOZRr^7FK<oNPjeRgV_8-Fjd@3wouuOx?;{BZQ6cfg|xb_(O=O1Rp(?5&pq83H%%k
ze+PtF)>xy;-oF|+Rblw7m~eWZz|-;O>ja8!sbBWw>~Kh7zfl|8uKg{ghCD5)5!kjv
zhjKZvRia|jViB_pWpf5c>RI|B(?24dl>JdDS|<k<u`Gzr0b;!42%ZE2N4lzO<n8D@
z-a-<z_Av2rF7n|8wM8VRSTGy!<_Og?6#rY||Kepa9%@*xRYU`6mZGUwrY7nHrLxcn
z{QeRc(eQY5vG)HI$eskoDP9pJm*M4sQQd@fuNsO3a-tY>f(@q#@8d&fVUj<|Ku=eD
z?v)B<&HEPbXltq_^{bp3?lZEi!P|~nqU-R^9n~`FgRhQ3`=d-!MaCdo77(hcVcFXR
zPj)QeiY?zpx-2YZ?20~2!d@EGrBa4cz@}j25(tQz*Bu!nU(hTC!ovwz#$kacn9rTZ
zGGew9)L^>EIs`(mFz^FspN5WkAY|x=Ro;W$6$vTri2$C|MaD8Nh}cT*N7vpiqEIH2
z+GjTn@cCXvAAnn*tPs#9COHA&nWU3q@$05^Ey{^?+%ecgImyyn-&D<}YxCs-Ei7Ve
zsZPom8<gUVixh2XKv`*)pX`>jT$5CSIg|}2kl5tycSR&B$@M;<<3Gk+e&Ir(3@TGw
z`n{rXn6)lin(XiLyo7_0ax^Zb*It^y%Mah}Oy#Xh&@+6?X4)K30NpIh5u4Pz*R5FT
zr^&<(cefU{Vh5*pF_x5Oy#OseZaje)vF~cEkwuzvH9uChye;>tvrI*C5{5S(luI8V
zv<B~UTllY=t2z8`ob0{jDpoWC{1djaayF6u7!JQ$PjY2CaXiTvv8^!q9gd_?r$1bR
zcxaIc#{opL{X4=OHp=q+^{OD@zK}#KxFSt$WsUmtYHI1}D^?+FfKCHQ9z@T=IP0q(
zqOpY_R(g<;I~<_E;h~7lucf+VYa({9=ue9x*`c3#(b!(dgu4T6{_<1QwF0ttuU$w+
zkxuF0O?#1ZKgLmm6kX4c#99noNe^j3!VIbOrZiV;?;KZ6p1~|x9k!0=7vpVGwz=uC
z%%y%uALodfCRYseq%PSbu_HpqSfOm@i+X4xy<o(f9zVe0GB>fgFm?@fWU0=m-ap*6
ztpNggr>WPd@7fDin?Y04zdF&&geRRh+T9$byUS3dc{!GUJfj8W$z)w9(D@8+G8M0?
z?v~f!<8kpA6AsgKmEYW~(hBsA4?^{p6j;e)w*G>YCIp4vHJgU!LpmUTk9iu^JJ>j9
z|8~C3wL~rwC&ilUugQVwddW}22JU6Me|M#um1xCtn4<t}X6_iPS{6TrnT%t={7RP#
za0M{AkcQ*rt$Z`~welF83}&G@8w#*PC*NQEuK)UK5?Z5T7-+IM4znx60g(kl%dQ5D
zSc$aBzTT?uq@%OOURZYV=7Wg(`1!^%Qdl;Q$YGTaMw}k5@1}DOnmxtIu!3=w^;}Ws
zvX1hdCA?G~nD56^;Nh^60-e;!ULXGc!;yrA1|SmmV}pvs>yG3};ZMv9<s%_J@~%X2
z5uC7r-?bMm?l6-*kELS;iUVNlH}(ou#?1sAAvJn6{j3u`#Z*_p5rpGI$V%hg%SD+?
z>WW>zBIl#MG9w-xu<NjR=OW-5cw?<>rZrD<qA8T_+W9n>!5Qus>MV`|Rgz9nVVgb>
zBdVgKOzcX~Sa?NlCqEmjUYUc)HMn``mmoIF(!+^uqXAJmNg0{JC2@-f$aaaCzaFR%
z3)d}R@)Ux_v}yjxUgfNmVbo1Es+FGgohJiD>E)yq?|%qwF?#OSQ|J;sS@f$hMO77K
zR*$4`Ro`IrDhfeWbT(~mVZJ;{iy-v42y%Vy(nyQdh(;Qpb=FrYPqwg0QAB_J8C<EY
zW2NrkkwcypU-=_Og4-OP9t8Ixf^O#{yUXE<&kYQF8v}^=Bkr~*by%&at?CL$!&XC=
zWz<e56mVFIn%(mIy;(bFf0vE-9J_R8jxBm*o@n6wZ~=`YJ1-8}njdQFdqE$`1y)dy
z`y+_9NK;T&S<K?1f0xs)pS3{&3d-ktwKKeh=b@({(|ne{f{_U}Zd4!}^TBlc!{O4%
z!>A7Td^+aX7*1&fd~$3x>gHX(cZ%b0Nwux7H^$cci%zz-5d6r2-euM`jvF<u0}=ep
zmqBlUid&ol;81JeGBy<La8uaH0iBLw4(o?>@pRcvPN@UKP=kHS>%-{q4?$m*2mwUr
zteK|_qof+{3Be+i%d2=u6sn`-u4P&vN@yoc{n~azO$Lev#b`Ana6fn|TbT$tAbni>
zZ(&O1=$Sy){Z+o2g6^t2+tjhpAWxlu-XW)$lBNRN-}eFo3!ZhRT>Xb#D&Lb&IOvZX
zte@=Rv#rMj$`*$+b#?7a86SkD-kE;!V}=_KhOKx`WMsV;gB0qwRW!sa?lD=q-p<4o
z$#1l$y>OYu3YS4aWRx^2MF_oN<}8NkZAHO2w-p#go!g9ArI#Ij2Q=LbF$S!kEA207
z?f9#X1Nqsp!cNxl!+O7}t+#ZpWg7#Nv34oPk@D(Txfk$Hji+39mLTPQ@WkA)63Bt;
zA=qy4zuVocc)TG?#4wf9-F<O0`1cuErt}!99F-~IDx%Uq4g{mk9nG>e=gqbFJ;I)f
zn;V`J8>jQL36b?H{xX`5O_{KiS1hOuW!mmb8<+&rg}t`CpJflLC77dw<4EPEeKj2U
z#sX4p36N7(Zkqw81eu?Oen2u<-IFTaPRboIwbB2lBi+s-r9-S#iCzEZ{80`ac#E}&
zz`jcMWubC8e}M@Q<p7|ySwKva&7w4EBPW2uOA@<@Ed_%o3EOTfBA0g9S}Uw@c;f=U
zR}_S`1bgLsX%}SgetgH)Uo$3i(S;`m|BhC7!s~$37DsX|83tGka^%iaB{`n#^e)AC
z6Oh?|^ynq3IL5rv&&H1j(EUUOzmyRwP#l9cp+MUxh>romB?c}7)&*SGzNw(k5f1C%
zTSUPZqrdQl(Um38w@kei^#e2s+ZU@YGvR-|C~x9XmVOC2dL5)sFvei~x_&sleOP+7
zFKr{*xSX9ulY!E!7DwSf5tyNb!rG*2m}C5bnR2ARsCH8!49fJCEx&4?p;@OXF}q)2
z_X{Vf%8&8V!qRVV%=D@Xq~N`@Eq(n&Z5>yie@GbHAxV5gmb6h-f*zPdcIaR*=10Uc
zf!C{EVs7clWYm{XRD>=XI;KM{M$JV<+rx~iK&_@|hNLDaufG+UE@jyWb!wCQ)Y``6
zB&mwLMNo*^jkY_PuVV~!A|{Gj6N)?q7ov7*3*am8yJDV>Iu8pbN1DNwmIYQbL<5;(
zLUfd=m8tai=EoILh5j#mP;KcXoNzQlmJuC@3Smt*qlsMiOiKCp+CDT%gl4!^6UBro
z^}YVBr2q$9F^&<{HOpJ^;wQG!4F{o%2ix20X&IepcE^;5YYb0EbLD$F7}$q<JF?+0
z2)c=v+)({sS9l<Z_uI1EH82SOk#JtrrL;|a2LAs(WKrNSzGxZ|*9C#|H+C?s*tWaj
z%l<F{0#8Mm{P&99*oGoG{&S~C4`2>AT>E>$d8xE~M3bp17`3p}-%<80jLD&8`$2fH
z7{s76iDmH>N0gaCMWb5W2(FXtR2Sn8DuVBcNRA(=W`dRp5)lUlies`Z$J3j|#jfTO
zo<{j^=1>INsGlAjdUm4SMN}1K#sK#x4Yr@D-olg$!?p@+JkB3;*bHMfY8c@-+!W_#
z;-*tdh(o^w)A$>w&_$K9g*|6Ueg~D|NHdruBY1y@?DSP%p`Idk&9^-7umSGIy6b&#
z;`*I3Y#7z{GFeP1op1|>5wmgyUyO<?8|H>=E10lt-UhOD258L`RAzUGPFpb|z21mk
zIXcr+cNn`xYMxD5B%1tX(qE**6Uc3JP~kt(@}~ieSkSrDQRZ}doTM{l{1zY+V|RE%
zDj6WY=Br`1cfiMC4R4hHy&h411ORhVQ%evhr7#d%7h{u80v~B%<;^3_=z<=vlJuUs
z#_9CdE<Jze(BZ0^kWc`k^W*nUXR!H3R#|kqoAP(iaFD|d0BF3_DNiVOz*GA6<0QbQ
zZr1p-i>I)0rY8a-hDVQ0?D5tXgTeyHQpK-~bBAb9Fp(_B*+3zs+Ni!9imyx~I5%!p
zY3jH<>zAeu8YE7!*$V*H&Yc*ewU+)kpF(a^i6MV-<fn;guIV+Z+ZLwsoUMcbkKLkb
zc?qxy0k%_Z&+nK^U~-t|gt9$4+VknZzh0gH7FQr4;GNZMy@!pZuWTwT?VE%{q`sC|
z>Y8eZ#QliNXwE}8XoOsu$dmcgB3w*o?tNl8k<seWLtDUVNle6_s6>|l6x;Lq30svS
zZc_l4j*BR&gdhsf=doX^_4K24wv)CMB3i?X=^DXLG~Bxz)mfPgV_+Tv%O!n*)!$59
z%DxA)w}J`Pg;{Pd-&%*FT*$X0_`+4u!riZWl+J0aAJCG3AaP>Mq#F#~?z9Yc4>`Qg
zwM>7BOk;_Ldz(*A==}LAps2zaf%^k8aX{eV&={+LEeL%XeEPt2($ks>CEu1s>=9+H
zAA_RNM0vn`)rc!~#58=2{Y82I&GTY?yF7`a?)j`OhM=Ekn1RGtmB{MG8%UuS)U0gh
z30bZfQaDSUYWuiBE*xanTitES7*dbW6gd!2!-=}CN;lp&-<Ddm#=hXi%(^-qXI&x%
z86*y211W6cvd^|b(qpm&1%QJKq!%yOj`H9=Hn=`r?8Kgd{6lzc&f2^3r_;z0d9BM^
zqEx%b6D$a9n<<Z5rH+k~_}PNFeN5Dd{MP|ys!IYxl+^5hV%{Vv&khf2*vj{1g%-`T
zs;HaRr|Bz1igt}K^(WR*Z|}CbdbuO7#ZE##R~v&<-@w6U^h9b%3&$Cjz}nCzfXJhr
zA0rvN=<>35yQidF#(e3d_MMPV@6vH>?3^B5Jl16${W~@Je6FBo7Ko_a4?Rjh5xxCi
z;3>6N*`s9%W7w51mQu>*)e`*`>vWGe>ov2jDB7DEcd^{TEX$Q=6Pw7pG7y)3iw>-!
z=!B`Y_;Pu~rb?gxTS2iEGyk*lW4_1?`7iT)CJ+Nl{jJBx&+;i-4+cPbAH|m>#Mnh>
z!mY;=PeI22GiC^V_e?F}vRI`s)S`gbA10Elcw?mTK;c)J14UNVO$xa*zE?%C3eJ`}
z*$Jr0BM_$HS7nUYyp!t;5QJW-{VH(($~Bq_P^hhQaYG)&)r6CQIkCFRgCD8UuVnJj
zv~|vvBNqd^NeUpNeTLlOKMHMtoTryHYrGcyV0tgWdQq+N*zL)BZ_m-jP^mp4{;=Ro
z_nhn2ToOL!l*LLGO{Fo(s8-FGLbs>0Upeanf9#UtJ3n^bcIJ)Tlo8IV;vR3g|L2dM
zt$Zt}iv6)W;X%#qqUO9&E;8$qQl02=ck7Cdc=bhnAaNfB`-p$IfoZD(-P=>xOn6|Y
z<`xgLM}poUX>bnaHRoM1K-@Z@zNm+;&nFf%?o;2eQfCqp;%Xzo7GJZ&tt%<n##o)M
z7WA0-VxUulrqi_Dwb>JD0lc8*<Mg`w+*GNHq|vYB6`P&Ea7}xl?#+TGR}d==a;K&e
zF!+yOOFRKHm2^!>ZNspHck)Ue(N1n=p-+t$0Uk&X<8i3Eb!xV!*7rZ$xmTl~EFsH7
z-uO7pUWS8}!c~G|+n`neyw7-4P63^9S&k{h+#Y;xm_hHc@6{6=4qjBW7Gtm`y}tx8
zmh7kq)<mS0c|VaU@lj>1W5T+Kdx0dDFpkQ4PuffqEJa_S<n7fs&Q1BFPri9__z>N|
zUel`PIpIyXb71XBj^mC|dV^)!tu!Jkz^dMlEq0Z~Y3`$-71UP=uA}$ePiUE_CP0%M
z8^!snF)sSk#349_0FqTyk<`eEZ4oQnH#{Z<dOF=2%(#dukyc(^1gHAdk)xFdb7UgU
z1@=7S-rMmA*`{^%0^<E*PU-|QKZc%%m`XRs7qCqMH+T{=3xmETWAV1o8EKQu^+L;?
zrt_{zGr6r7{keG1sg}`kB4;~ed*=}iMe=EIj=-2UYuF?)Tu7HW*6?@t;qmeCC6>tC
zUAE9>J>d-{+^o<jb}Q+9;{bPoQ)p^E1BlUYqzmS~=0~--W6L*@>BKbCUmi%HV-qIR
ziNo&p*JQsBPMpLfTy#>}(Fx|a24Ugw=G=t+UCOD_n?pONT=Mtzz5>T0{H<jbYs&=3
zE$gIklzVxf5(gIQweh3(Fql!%e%y*dyji#nTfIYuF)}$C>7e;~YSJFKcL&ccwTsyG
zQy|o&`5pJ*3`mb}%~<@RgRIe8+M}qqnsj5!5sR%#4+~fQ7Lr}d#Zj4yv15=PKGvPR
zuvv^wPnZlcB58xw+ZJ<AS>23~GRVW}0eFPa&s49eZBIP)1*CA<KuEKJ&~Wv>{a{L3
z!|Ff6c4&Kb^fmWF%J-8OqfNw!;&kXq0&gSS+H;Ir9Q9P?uLAw4NQ3be;!Dd?>cS}U
z+mS#x?E#Ce5M8erK;;Vzx>A5xpH5Ed!z;#lU=vl$FAyUm@JFy!@>8S;&%_|sv6a8(
z;sLn^@NA*{bGwuN{wO2q!Bj1E{5W+#y{P3(1~Cgmkm$4Jxfg^lLHlpwOUNjE`+nRc
zmDhq$_)Q3reuVZtiXaVL^&#DYjSUB5Mj`U@t69ka=$YO!xksN3>;o@;1F~eTp~Zo%
zLZ(4F8`VuWNHkKq;lGKxC%_^DWTJRs2HT<-`z$p><4~QQRNyAW8IsWlweg_~2X&)x
zA4Ddub3+s(BJC9BxyJa$&r}kT3X14K1qw?H77<{zC>wvJ6mG8p*7vZ6tKE0JBC=-K
zURd&{F&$;D2P^L2zi{x}xnSf4UMsu^rUT+=D*EALSt<WL9sam(ABf#AcKbjKPSk;U
ziC|C1_coGj!71xAPK^^>#ts2D*Qn^idd~vOV9dP4hB=87F9Fi9?<ybn@TR4UFR_E`
ze&#UKNhL4%>F#x7A9k~rp?8iWuu0IxVZ*QCpeU&7{Vm(0K=!a^9>{c`IjysWq<EMR
z+Puky+b#iOG^OL8BmALu|FKcX&;aXBz>T4;PF{dKM*La0jBwRvxr~!Ru>E&tEkBm0
zcl%tPt`B?yFlY-gGpTu2|KU_P8#Sye9Me-3JQN+{bhrq}?iU^H{n8QR(fcUxOGS%v
zbt1mADhI)=<E6E*0f<lz=ID$Gq$PIg$R9xZEhyq~(GqnzfuNCgux2)DGao;g7O=ud
zfw4LUUB<)}S-9bpX+E|~p=U};p(C(!0oq7}cjaTy&ueS%It$Xd^~ko9a(04<->uK$
zGnly_;4&4CpHQS`!nTC>R&dGZ3&uSp$@k!9b|N4(WCyGyt;xSZuWarVl2PwH#!J}z
z(xzU$d_=7}evH&v-=o~BE%H&{9IP>Z$R7$uOFR4o-yjh-V7Aw63#qtom4x>MBVM<C
zx7>`)bU0_m_;j4Z@qgBOurMp?BFnvUI)ikD6-j|DM(v?TA7%rQMrm@RLi2q6*dewd
zXfW@Ik|+V225f_BQbn3)dY{K+l$EUg84k%=tcW8f+K&osk{Od}G$stj@zAXv$B|)U
z5$-|azfoZiaenB|P{$k~;M;GA73*T|>(m={2(kD$*Udw6vtPn|3kIp_i+@F>7{uhp
zr}t3>KxdKgWciEiWCFB2ZRNy$9pApW38!em-LYLNd+3m4J|viNrp0CAO=qkw;w$iy
zI^hI&7)k-ap3paC>hGv{zqsgr;s4{3GRbBubHzYPQaPv>w*zfUUWd7lT4L-@%xr85
zpFFDRUDPk0drgdjUtNFNHY{hWJ+{=m`K)CU0qnEFp(NwC6(leX;#QaX)`%)NeNejH
zZ-AD>4MrnMaSEfbg_v3HZVEd3_4_scyw8b=vJK=y^`YWMg-uVyFw7GAl95Q|D=m%J
zXp9tDwvB!G9_XVhhUI)=Mg$fO%sGjLlq|e3>G8YB%y;}DqJ$;QH#H#<joUpjm5nz+
zF1b$}ntm5Wl@|XgK%W{55R8da-b}+$NIiEwLC!l%p{7gcOH4XQmcWt-BiINxmkJH7
z*kpP;@o$5)Kiq*!Hj9LfGmKLqTE^1$Y59Agh*mYt8f6Q{&glzvbU`PqO4S-!4Y_ig
zaoG=VL^K;|tI&Xf(JlsqF+muv1L1@a!qbE2xkBYiB&Wa*co`N=b*V^K!nk(@kNZJP
z9j=D#PVKQLU(vbU@4?K)qB*@)uaz4JK-8NCJV*zJRKPKt=&^>e$-zMtU2Wy=Y9#=l
zH%Y0c<`b`m=N+Z^%N8Ng-T&hBcFK{U6L8pNe)o<63R4A_=9DRyx-Lzp%$t*z=ue_n
zl%7WqISP>MI!e>rYG&Hk)_lSVkS7a?VeQ9v#scwZJW}QhD7_l;8%MYStp<(Rw}`os
zt3Z`0aVOAu6~TpSJ6=(Ak-?Qx9$~S%4drHCl@i7n=Lf552s<dEx=N?Y4a3`7=GP&3
zfzcK*HCRZ);OyVdj4Qi?^gfTp)f`qc`{^&avk<GE;5h@2?bD7C+0KQi0)P+OH8I7i
z%}uP2H^aCimYd8>((iyjXU)3`ZNY&&gz_>yjC{SZ8}+q32_w0&6#AuP6|yr%6^?WS
z@$5jP3+5Hd++g$_aF5uc%OI8uHal~EtgWhlXBnh-+ad=;y8~fpJbW5-8p;7uHBg1Y
zOt~m18{OEEvFcT}jc@N-3J{zGg)7XL=!&s@747VJ(BUB@K|OW9jh87;Ybc2_X9B(~
zj%7g(25+@{d@7}NekXGZ=t=2#0fC1M9%Z@Q=1_^Hpk{rE3+8&>v`_$-7I83n1-qfK
zv4f(1?-qH&%Y|EX7)hU9#7U@T@XtCD^Mf89=@KBEDZoTXpEv8uV-ACTpUeW&BoZn<
z-U+3OYWKCFK4QGkZ11Wmutu_JvSwyiMrueJa&=^82=nO8X#BM|PnEp{+E^b4c9$w&
zLro&0GPZnXw>qKRXi!*Jx>#I?*B;Z`4gCK$-Z3KpTdYR${SB0TH<p~tW%1sqy^Qc$
zEvcB6Ib5O^`yy4LDu<7N&SijT0#v$z%@vcNlTyiWk~DtPBGF$pTKq2RU`a#JCl7P(
zkerW?bA~;ZX8yXIOGA!GgO?nQ0L$8+l5QpBL}k~Uk~DX<&8BY6?{gYSvn=3<Y8In*
zng>M%5x|mikU;<a-$O>g?z?Rsj&q#Bp7*TRuUuatu$x05hb%yVUCQfgAg!t#7=r<2
zr0!yiNn!n?4C{pw;zIUavGXu`U^~UqA<fgXX}tSyNM%qNW#=P^*ubzV9?*?9wqj@0
z%dm{3nU<tr0@KlM67xg6;~8G3^m?w%Pa7vr_&fwV>F#_S(-4{E;GclDq8}F06IMWa
zhc1SE2^V0*r}FwQ`c4sU{LoCL7jiqQBRVg=1BlGM1XH1uygrRKNK7M_b@YrvVf(f|
zZ^in5I1O-^Aszk=8U8F9gOBo<8)Ls|TjqfUGk=t$aFOlV-g*0cTxtwx_43J<3(i0%
zOFo6fOqX4?=F$F^h)tTwqreT51A^rQlc9(avxAkRpE2DQXqlu}FErM60R3D;nhD>l
zCFF*`a^D0^t$ZKR6M&_qLY;RdeW<B|#rYvH<u4-5@{oOybN_go{k9Y3-2$@5&lqx-
zCe`hNJZmc?Qd_y>3-1~R<<y~Cpg!twc`if>T}PH*^&XhG<5s(n$sG8!l;<yF_znE3
zuz>@ZGN5mkVk=qe8`q|8=D66HSv*s(X*{IjqX-YgZ`%o&MRI#Ge6VM0Qs84D7?cJ-
zS;5~WSGd6~VatXzfs2+<D1Y)Rw)lik7UIPho!cTPko@T16IK3E@I$k6{utO%oI*@n
zA#N+ogIk$%{fl5CbtAYe(U7_^Y%i>un@spix0o**t~2c`?l`{T`9q?R6w0s$S98DY
zfD^Ot_brQ%aZ^K-+C-q!6V1M!g4jz8(*_^o#!70u5K@S&yFOWPZz3}Gn~uA>C>*mi
zF(H7t=sQsH!rI&j6{`suY=N{ddGK(NNeGpVg<7gInt}*NBYLXkNRxISUcIG6oW%tM
zFVokKK!cMVeLq<^6=uBK$IX<tF&T-z*lr)1bWzvJike%k>!d0^;RlvxRsph0CRKG6
zdwE^qNYrrQWX6~0X}&qSfva>-8JLi_=OFxO^;c?l+G7b$CX2cAV=@+v5$jkZ^MudV
zFD7V@Hj+k|4Y_Jl?~rc6)WRy8Lj`7OGYQiM^9|6hZ;6)tjwxBix0DrC2e_}PNnNXo
z6Q`&E<$x)ffp|IBTvqF#$SM6v_CO2%6p{e>H2j&{GC;lUcTb;FMW<yoN4PT2gv;@V
zFb?b6w}>HZ_a2LC<AO;O$om8xhif4UW0{vhl17W*uiJ9+n9aH>o7+8ao9&RFF9jcj
zi2w^$RJAG3C6-N)n&C<4FkyFAL-?|MH%@!Z;kdSnvYOZJlDA3!DFzv6KQL5_-Fr<>
z-oNn}+-RZ-kQYtzKH0CBCs2&&e5*3gR|c}?et@ez7BKkL4kb~*&^A!Xxc_wMuM_|A
z+<R|daT7*lU|s@>vyqUGG{e<7sw6aRgLvVtla;1PwKn~Jlk+i`=|XvOm{E3c9t%1V
zrgMu>J>Zl?!pNY)k2&V$XKgDP#>)6xi9{MHp8AJMqj+>Z+GGhF(ou0Sc;;`bim*~5
zdN%@7XW6-S1C(Eh{v09h#p({nN-!os%jjkQvdj>S8yVj|&QUK<5OB2x)okw9+15J{
zPQJM_T@;V}6;gD=h{k)uX%Yzq5PiHfB2N1H^{*uDo^m4&Ht{L{b!y$^#%Mt7Q}&Wa
z^K~l1yP9}ODiKnALtO&m6te*QMYjt~Y1Op*gr`n<J6$cp$-*a*!*G4Tv>U4hWUe;(
z_y(^*PF@&=J*Pp0Kb-)v4GRm7JNU_a|CFuG47_fm+Cuxg-@l%@<RO&``FNd<!y(*i
zy?ihBKMCq8ZQB5V!X2xL6e=mGWwa5Bn{qjwD)(47Z*5-U96pLFGea#hONS27%*(kH
zotOP&7aLBpbYfXIr`u!|dEtyWXS?s`aUT<9Gwasc+1ikfdlqGa>f0MoyCu&(jZ|z8
zeWVbxyqAYnn2?)tL@F|#qkJZgSS<kl-xJ%@R63C(K}~3p2E#QdIr%Qj4MBH1w*MuJ
zf4*?7b*Knm-1XZ({nxXkU7a8K4wcAE=O~77XsONI$Xgrz4J1N{XkF%^smC1E8FBzB
zVM1Yl#4)a6@+SY(P6TKpXdWGx$L6$h`q9oepv@(Xe`^G&Ql&ruUi&$~wu%c<lxdGB
zt2!sxbk8ZjJpF8Ob_$%$4g-S{|EE3CK+5E1<AK5+t1b=I{g=HUN!_|meUOQ@MXO(%
zX)mJ8>y3*uLywH}L>{fwmk{(RB=QMQrzVZ1ids9u*k|4rGqU)3MP{GcYdzMPgTd6P
z&@=*a<eAA53njNmo1uN^>Nf`y2sfbVa81%~cFW&ATCrPpx<Fhj;MzEJUeUapN4fV>
z+D4p7%(%Fo%b(!4gvL|hp^oG%*lWBZUNvqdzPPKZIzgJaU<0xe*9ts=r+yaiV4i<i
zHKC_N`OC8-)m}7m6ir^G*C@?~uPMju)Za<yX!QkmL7&~jk)yZI2@I!H3SvETDKe$|
zEC2>>){fKsJ2<2-8y@g3gbdRvC?q>9mQ@~sIV`@rOIJaOy=o{2{2%Nl(f_A<C8INl
zv}2&U#;?X?A_>*=mA5|f`G}FA3KOjS!Uk4C6L?uhezB;%k-9KS#?^=_9E<?LB|iZ^
zw7|z<wmg)UdW({O2B#-j1kN}B4dG|%!YTp6C*4*)lQJ0t>;<Wl*egcm+}z9QaP9Oh
zYe5@%P%+ciAu1OB=}IAJ{P|o7qO(3JUo;3IH{n>FlC6@EXJN!-mW@5r;zjy~aR~M%
z@qm;|ovA>`TIA0ZM;^7;m#iYtU4%fS(#Aqo?0BVQo?s0Bs1x61hbI31GdIMA_<<Fb
zTSGMc;9UF_Av}K7ycsH}XgFzEkEB1JHuI(ea}DNv-JF6vMww{bW-UsyA_W#z>4;(R
z_+=j;0nCW4MN)yk#Q7_Dq+&JCs(pzc&j=!n;4Ya&=r(#h-`%LQu1t9No(v5pJUCLu
z-=uIvt|JBdItOQ=4I4_R`9`bw^E4z~(1Vu$yubAGugo+>eLC4df4f~8cs8tYyM=^@
zCl_bV<Uv%EuiYlfr{{^;{EU+-y^NGO1fgJp@+)8wv@pA)ZVrhoK9d$<#9bz|z^?pX
z_YQy;`TMzlvqiWn4fG<q)c-=@>3~?NYyb__dQi;B1iR?{^{bGHf@cE!vwi%tH87UO
zJ73WPs&SQpk-|y-FYX~Fgl5xcq!b03GPL1kw%C$``9?qU`zG3_THmx;ph6E{<=onm
z2XU5mLf+NYif@3{0eIS2-uqXX6Uw6?QbB=(7Tk)gxI<5Wh)c)73T}|RuiOwA>*S7-
z^rns!|LIS@X0R?o;;RSe?Lww<8K4D6Al6fLA8>L$ri|WE&Q7zp@R`i5gzBlR?wU1%
z7thhUb)T2E$bPv=IS7iW>Ri9=IS%ZHSiBT94-nyo!xw^<C$ex|bAPW3!B;Z4NJ}s`
z$x>;E%1TR%tnUdi#yqpl%bWs@*N;TD3>L*OQH>NJw@bL}RP~G<CCJ-vbkXtSVawAm
zRPt39vI+kqmjEYAhw879yDXS@kFHHS=!|z07-KAOrD&PI10{VFHyt<Yag$b(M;FVf
z`6m?R@Vk*2l1VqDo&`Rhh#N;O9!|65Pc1c_Fp;tuzj4DisM;>hpvAF73#y|%B<oHT
z!AVTT3-!Zo`8ZV&pQnU>(w$c1PE)G`$LgVKhYUSnAj;0NwYwu54Hff%qyY*kO}N|i
z^g`B90>T1F=K87c`tei#jwGOX>8+NMqNzaYD*Nc*x#UcQ>z)pTT8`n-$j&5kKkDbs
z0=U-0KAzZ9oPgCeHv{7^>V=N3l5W<=Pm4EUyXs7P2xlnvs>Go@xT<W=Oh8U~XRDyB
z9wM;>LMUT(fd>`+Q(~#t#DpMrBk?6ogk&Y4^>Rfd92jT}a4RMNFa1UyUa^_vHDa5C
z<926)?(qN0VVjk@M$_pnBobKN*#X^ypPeE#+0j4wJ9I$*=6g;~^ov;drfE5@@hD=*
z0|RO)uEK?2&{P;;>mp~>SdmrBUO+Mz7&?DA-Z@NA(VJ!lBDFyY<Ru_ymC3MUt~sqr
zC|R=ZJjELRP~L{7lk~HW^2#mVk_4vQuxKDf`mqaedRwqp6`OM1fapE6z#KU=3*46!
z<&j@^m2wy<#&E(hM(g9${XPswMzHS2hE;~drZ*+5Mz%n=hqdgu_tTsu|J9Kp<b_j(
zuDw!GyxE_zYHi-EQ10ytPhE7#MC<zTTYwF%n)g~UOXB#tzG2P-;q#=*B^*_Tht4MB
zE?H!-IuO08Kfdq}5WdPJAL)Ii<P%*#G67$2^|l&TK#LQln$3dGFDPUl1{}Yu;CK<r
zrR-hC>CgQ>VoIm!2VI<(3AKT0*wT!6vXr31(v{S^9@C+YGHh~4#EAD!@_n|S|F-FU
z8q4QztT??}J)}m;_-KUY?63bP_5;OVCK+x^<ISZWw2r-ecQCD3YKH>9JiJ1}o6)Ux
zJL-kG>;SUFd#r@t(ew7v*d|==AoH&Y_H2nxAPyoGJ(l=^l+8#^EK-Y*gVz<WHMjP2
zNudFF+T&?yK^H9_pcCUi;5U$mTSKg=i8gD>mL(A~PF6=34W|MwiQ2l;lWGCszCvdW
zQ7YwZdXJ5{tiy}*z=CEtJ|?N$1*Coa*h%<s1OTaNj);Tq=Wg?t{^cf>8%<Tfe60cI
z<J!mm=0`mV!pJNxaNdMT-HsG6n=$oQ=OvlZ`H=j_{wstz0AuDpkLXS^ZXQ`7WN!;S
zIh!tT)jnKbmT#6=uactY({5Y8p=jBX9uRi`xkL8W92X8EwLR71=fc;TK*{@Pk+Cf-
z3@)-QAThCMSL|z)x_vkI9N$<atNvPEih5L*eHfQ}ns0e?eZa)7Li7M*$26A3WRA$*
zNkf5BAj%wW+S#D^PrjB0epK>uZ(<@_LNA<}5wKuCWVH!?E`H_p0nBjbIGPA6bj63t
z8G*dCg_v<bRdN7F+fMq}JW)U}?`b+n?G>>y+R3*GxP%T&or2vOAGa%-(~yQlp5lOn
z@k=j|U35X?lhjww3A|_Yqm%$&750ga%~mS#pBIMS3YSdPlhw;aGjybRifzR<zlO!&
zz>$uH&j873U{@(wGsfhzg}ZXI#e^7H^O4+X1pW0%0EiT>FeRlM>yO*2vw3g|3k9kB
z4+l`FRNA<WgtDxiO|}hy-<>*%jxLTu6RpQeU|R(aK8>{}`A?C)eXmb91Y!GF9nhs0
z?%#sakZs=+l29VW_d2qCl>Sn^)K)Tp2@)X<wU>l&{RX9hGYjSwLy7&c4I`<5S+8N6
zgyZw&xJQ>UKpBFY)^G&eeaVJ1IO@v^dy0m9eMe_}kS#TrTHR8X<E~gD0Js`IfP}zi
z^KNQ6o)-7#18sHH7(djg*?{QEjQfft&S5qipe+>=e+_8oWx=?$B_QeXjxt@y?fH}%
zZ*1^w#ktHM>m>E@wTh`Mu-%GIjjb}D42Q#3u>|(<Txx)%KoiP&p$G~l@wS*S8%|#K
zZ7|KVZWqnc(t`CA>kqOS3i}l??$}B&=c3XkTGNg58+&uTU9t~w2294FXa2$bhdzL=
z;qg25ubRQi^TMHgi?>~VA);U1d-$Iz`WQ+>us4p$Oxz7lqQ1Xf8lZaXEyE6V>nU&j
z^8BHGGIgPwa`#Opp_EFYzlusi3N4M`+DeT7yD1oLKu^`A33+#_lNk{N%DZ%w@#Ue&
znSoCx-+VNIqh)^T#N&}+e@)}X4dPli^f}iBKirnt+&_DM-Ju>c#oNI0Oh4we{)?*A
z%Pro2m%Z*%ui5Z&^4b}-CO_Z$J1Q_vQUA;z)REIvQFZXs{^}W_CoS)st=utBZj*oB
z7K<KpF}<n0i#BCsWqPvf?w)#L&7->u<qb>3m*r{X+PKI(EaDNZH2S>F=FBGE&kOo~
z8XQ?#^H-w7%{}*sw@bUf>zTYw0*n`IPTt(R@KJxYp5BRdtDnrPS6jbS)oQt1)|yK@
zB%1bq)jZlR{lH2>>pFk&V%wARAOGy)%si2_D!NB1E465f2BYn#KU+Ls&Eh^go%M~w
zGPOy4e?&q%7Yg5t{Kv3vc~RPK$HzzVT0GNjMc=Y>G}rH5;5AosHqVa9aa)(nDP3bG
zAER6G|EAE&FUJpSJ$lYRH^#x?>^gBF4K1x7Zkzv_PG>)~{U~#~rDnp<`Ae64n7hC>
z?C<N#Ou5&NW$XV>ImPa?wr9<Y?d2zL+ShXSeS6W<Q@g9mx>Y8m-L}tp@#c*z`SX`e
zzf>Upe0BAQ^Pc+5-<w}vzQDKo&GREI!oPJZ_e{50f8<E!O99DayEpRfytwT}c-s6w
zHFcMx{H=ub6jYdft{q`Z(!R7Q{pXGuwbM$%Dj!cj((*UL;pNjgTbO|Bc4mEwN}hN&
zFZxUk>)RW(t8<hln?CHE@Nw2t&8#ejC{|~A?n{hwQ=FffO+NLnrqx`w`A9^I=8f+>
z?{2To+w?x|1K*Ei-)o-*W@~IU*YR@tbarX2X=R<QXw{a#r)Pw&zI!K=L(;TMVyjE~
z%i0C&r|D%c6JA;Sad*VVxzW?U6!S2$?YSO*v{6HN;<TQ9FPe6)Tf%L-|9@z~p9S;x
zuRCUSuWkkVQt=y2tNq*FFJnkseaRwV3-9jzHL~5k&7pkr?k?@Qyf!*L)wbX4<_5;u
z=O%6ObGdDCqF-q4?C)=Um4rUVX1e~YRgS-u!?yByZse=h=BYL!%^V)-Wo1+IUKH$7
zT=(?(&FCGIeQm2hmv0Za`{Vh?-G{RyZ!t}6X1w-##gfP=0{^6s{56xWTgy?tA!XCm
zO16r)eFqD_3OLIB_GEl}yl>YUj*IP^mY8llaVyfVy=KZso;n`APkSZrCz~C4e9HXE
zqSkK>$1i=2&$p}#=}TX>eUmrWMKh(CT&60$_2-r^UDW2|zBFkQ_qtSPr|BN@?^<PU
z`1+re?qA?KVP5Q(zI^jnIUAoQHKmwt$>`VglX<+#PdztzVu6mKa_~(D(QKx`!+HC(
zbvL=Ka=rDbSMTeY!%B&tlNqOYm28_8P}j(_ZK<}`0?*Y3Q61+G<y56h9_~Moz24la
zY2CJ{6_foPP2X@H;cB|uXrq6)^@@M_?WeyMdSBsMw8hR2c+~aL%MUu%tu2+7h|$<o
zbJfHzG_+oDd&h^XSsbU|zlhDeWYsGed}T|2$;9fgO&479T>ih4U~2z(?ch1D%fOj&
ztEMJfIjP3S$NW<QqvhQ~o&+yYHU6DCX@^m(#lNuscLhT3x~0S`pZc-9Qd#c8kzaK_
z4k_G;pNz7mA9}C8$Y!^x6Q98>LB0t~r)OG=PW*Cq?uRSBxpVv91*<CEGX1+Kz3!@X
z$BqZnr<SX4pLy_Q_1l<5LJ8X^2XxC?O|@n<dBPoIGqZ2nz21NCm(}Q66uvsJL{GO<
z`_hWoLyk8?K6X7}XN@_?F#AQxlG=`f%4~&vHGy}>YVH6J=$&u<dbU=4eU1Bn^DdE;
zfP)-gIihDB^i|ux@loLPH(MGX9l5|{;w>%V{0}%49J4s_%h}0qrk1EJE1wpa{IPn8
z`tdn`KB<=;18$7eiMgDcvaHW8`)jF6fWw1d=Xs0FA8%V3Dq$#Wd{ES=dUi;i&vAJ^
zgIkUv3~o!gCeMw!@23mAcYrTFH7~U|vpBxEq$o2l9eNYNR^a6TpKqGEnlyPvS>D_G
zc0-WH_wA`%OFG$Vs`DL$SD*P;CID1IJw>3~2te0&P)0&rpUl8;H~{JqkeNWB4!Np<
z-^l^Q0|KZx!wLp25D$0*!>a@ahEf9thV>^PIB^9~0(6T9kPoJT6d1VPOxXcrLyScj
zH!2Pb0SHZM_;f(Db?y5P1rUCBHI#k^rT;<b9x*7b2c_MhbR3i}gVKFadKr}72c@q;
z>30yimkmnGL1^@wI~YN?yMO>J`3OR|a6Z!|r~r&&1|=`x4K2J5V45JoECo@bo&%vZ
zpFn6W8C0721%%JQ@OZ-!rx|}_L}vZ|a$;uwP8Icaj!#l%Pxe_db*6Mh(2h_-@=$Ya
RVCJFHy=D-8?=e`6004n#Dggih


From 4cb3a692f7e4fcddf77e403e73b9cb8cd1864d0c Mon Sep 17 00:00:00 2001
From: Emil B <eb@concordium.com>
Date: Tue, 2 Apr 2024 16:15:30 +0200
Subject: [PATCH 04/81] Fix some warnings.

---
 .../Basic/BlockState/AccountReleaseSchedule.hs      | 13 +++++++++++++
 .../Concordium/GlobalState/Persistent/BlockState.hs |  4 ++--
 2 files changed, 15 insertions(+), 2 deletions(-)

diff --git a/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/AccountReleaseSchedule.hs b/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/AccountReleaseSchedule.hs
index 81999aca3..e39bdbe22 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/AccountReleaseSchedule.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/AccountReleaseSchedule.hs
@@ -52,6 +52,7 @@ theAccountReleaseScheduleV1 ::
     ARSV1.AccountReleaseSchedule
 theAccountReleaseScheduleV1 = case accountVersion @av of
     SAccountV2 -> theAccountReleaseSchedule
+    SAccountV3 -> theAccountReleaseSchedule
 
 -- | Converse of 'theAccountReleaseScheduleV0'.
 fromAccountReleaseScheduleV0 ::
@@ -71,18 +72,21 @@ fromAccountReleaseScheduleV1 ::
     AccountReleaseSchedule av
 fromAccountReleaseScheduleV1 = case accountVersion @av of
     SAccountV2 -> AccountReleaseSchedule
+    SAccountV3 -> AccountReleaseSchedule
 
 instance (IsAccountVersion av) => Eq (AccountReleaseSchedule av) where
     (==) = case accountVersion @av of
         SAccountV0 -> (==) `on` theAccountReleaseSchedule
         SAccountV1 -> (==) `on` theAccountReleaseSchedule
         SAccountV2 -> (==) `on` theAccountReleaseSchedule
+        SAccountV3 -> (==) `on` theAccountReleaseSchedule
 
 instance (IsAccountVersion av) => Show (AccountReleaseSchedule av) where
     show = case accountVersion @av of
         SAccountV0 -> show . theAccountReleaseSchedule
         SAccountV1 -> show . theAccountReleaseSchedule
         SAccountV2 -> show . theAccountReleaseSchedule
+        SAccountV3 -> show . theAccountReleaseSchedule
 
 -- | Produce an 'AccountReleaseSummary' from an 'AccountReleaseSchedule'.
 toAccountReleaseSummary :: forall av. (IsAccountVersion av) => AccountReleaseSchedule av -> AccountReleaseSummary
@@ -90,6 +94,7 @@ toAccountReleaseSummary = case accountVersion @av of
     SAccountV0 -> ARSV0.toAccountReleaseSummary . theAccountReleaseSchedule
     SAccountV1 -> ARSV0.toAccountReleaseSummary . theAccountReleaseSchedule
     SAccountV2 -> ARSV1.toAccountReleaseSummary . theAccountReleaseSchedule
+    SAccountV3 -> ARSV1.toAccountReleaseSummary . theAccountReleaseSchedule
 
 instance (IsAccountVersion av, AccountStructureVersionFor av ~ 'AccountStructureV0) => HashableTo ARSV0.AccountReleaseScheduleHashV0 (AccountReleaseSchedule av) where
     getHash = case accountVersion @av of
@@ -100,6 +105,7 @@ instance (IsAccountVersion av, AccountStructureVersionFor av ~ 'AccountStructure
 instance (IsAccountVersion av, AccountStructureVersionFor av ~ 'AccountStructureV1) => HashableTo ARSV1.AccountReleaseScheduleHashV1 (AccountReleaseSchedule av) where
     getHash = case accountVersion @av of
         SAccountV2 -> getHash . theAccountReleaseSchedule
+        SAccountV3 -> getHash . theAccountReleaseSchedule
     {-# INLINE getHash #-}
 
 -- | Create an empty account release schedule
@@ -108,6 +114,7 @@ emptyAccountReleaseSchedule = case accountVersion @av of
     SAccountV0 -> AccountReleaseSchedule ARSV0.emptyAccountReleaseSchedule
     SAccountV1 -> AccountReleaseSchedule ARSV0.emptyAccountReleaseSchedule
     SAccountV2 -> AccountReleaseSchedule ARSV1.emptyAccountReleaseSchedule
+    SAccountV3 -> AccountReleaseSchedule ARSV1.emptyAccountReleaseSchedule
 
 -- | Add a list of amounts to this @AccountReleaseSchedule@.
 --
@@ -122,6 +129,7 @@ addReleases = case accountVersion @av of
     SAccountV0 -> \rels (AccountReleaseSchedule ars) -> AccountReleaseSchedule (ARSV0.addReleases rels ars)
     SAccountV1 -> \rels (AccountReleaseSchedule ars) -> AccountReleaseSchedule (ARSV0.addReleases rels ars)
     SAccountV2 -> \rels (AccountReleaseSchedule ars) -> AccountReleaseSchedule (ARSV1.addReleases rels ars)
+    SAccountV3 -> \rels (AccountReleaseSchedule ars) -> AccountReleaseSchedule (ARSV1.addReleases rels ars)
 
 -- | Remove the amounts up to and including the given timestamp.
 -- It returns the unlocked amount, maybe the next smallest timestamp for this account and the new account release schedule.
@@ -138,6 +146,8 @@ unlockAmountsUntil = case accountVersion @av of
         _3 %~ AccountReleaseSchedule $ ARSV0.unlockAmountsUntil ts ars
     SAccountV2 -> \ts (AccountReleaseSchedule ars) ->
         _3 %~ AccountReleaseSchedule $ ARSV1.unlockAmountsUntil ts ars
+    SAccountV3 -> \ts (AccountReleaseSchedule ars) ->
+        _3 %~ AccountReleaseSchedule $ ARSV1.unlockAmountsUntil ts ars
 
 -- | Get the timestamp at which the next scheduled release will occur (if any).
 nextReleaseTimestamp :: forall av. (IsAccountVersion av) => AccountReleaseSchedule av -> Maybe Timestamp
@@ -145,6 +155,7 @@ nextReleaseTimestamp = case accountVersion @av of
     SAccountV0 -> ARSV0.nextReleaseTimestamp . theAccountReleaseSchedule
     SAccountV1 -> ARSV0.nextReleaseTimestamp . theAccountReleaseSchedule
     SAccountV2 -> ARSV1.nextReleaseTimestamp . theAccountReleaseSchedule
+    SAccountV3 -> ARSV1.nextReleaseTimestamp . theAccountReleaseSchedule
 
 -- | Get the total locked balance.
 totalLockedUpBalance :: forall av. (IsAccountVersion av) => SimpleGetter (AccountReleaseSchedule av) Amount
@@ -152,6 +163,7 @@ totalLockedUpBalance = case accountVersion @av of
     SAccountV0 -> to theAccountReleaseSchedule . ARSV0.totalLockedUpBalance
     SAccountV1 -> to theAccountReleaseSchedule . ARSV0.totalLockedUpBalance
     SAccountV2 -> to (ARSV1.arsTotalLockedAmount . theAccountReleaseSchedule)
+    SAccountV3 -> to (ARSV1.arsTotalLockedAmount . theAccountReleaseSchedule)
 
 -- | Compute the sum of releases in the release schedule.
 --  This should produce the same result as '_totalLockedUpBalance', and is provided for testing
@@ -161,3 +173,4 @@ sumOfReleases = case accountVersion @av of
     SAccountV0 -> ARSV0.sumOfReleases . theAccountReleaseSchedule
     SAccountV1 -> ARSV0.sumOfReleases . theAccountReleaseSchedule
     SAccountV2 -> ARSV1.sumOfReleases . theAccountReleaseSchedule
+    SAccountV3 -> ARSV1.sumOfReleases . theAccountReleaseSchedule
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
index 2160f1235..81dcbff4f 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
@@ -1703,7 +1703,7 @@ doConfigureBaker pbs ai BakerConfigureUpdate{..} = do
                         MTL.modify' $ \bsp -> bsp{bspBirkParameters = birkParams & birkActiveBakers .~ newActiveBkrs}
                         MTL.tell [BakerConfigureStakeIncreased capital]
                         return $ setAccountStake capital
-    updateCapital STrue oldBkr cp = undefined
+    updateCapital STrue _ _ = undefined
 
 doConstrainBakerCommission ::
     (SupportsPersistentState pv m, PVSupportsDelegation pv) =>
@@ -1931,7 +1931,7 @@ doConfigureDelegation pbs ai DelegationConfigureUpdate{..} = do
                         modifyAccount $ setAccountStake capital
                         MTL.tell [DelegationConfigureStakeIncreased capital]
         return $ BaseAccounts._delegationStakedAmount ad
-    updateCapital STrue cp = undefined
+    updateCapital STrue _ = undefined
     addTotalsInActiveBakers ab0 ad delta = do
         let ab1 = ab0 & totalActiveCapital %~ addActiveCapital delta
         case ad ^. BaseAccounts.delegationTarget of

From 35a64f0bf4d14ee1d1cb7153724626134031080c Mon Sep 17 00:00:00 2001
From: Emil B <eb@concordium.com>
Date: Tue, 9 Apr 2024 14:53:04 +0200
Subject: [PATCH 05/81] A bit of work on the blockstate.

---
 .../GlobalState/Persistent/BlockState.hs      |  2 ++
 .../GlobalState/Persistent/Cooldown.hs        | 21 +++++++++++++++++++
 2 files changed, 23 insertions(+)

diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
index 81dcbff4f..7e84612db 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
@@ -57,6 +57,7 @@ import Concordium.GlobalState.Persistent.BlobStore
 import qualified Concordium.GlobalState.Persistent.BlockState.Modules as Modules
 import Concordium.GlobalState.Persistent.BlockState.Updates
 import qualified Concordium.GlobalState.Persistent.Cache as Cache
+import Concordium.GlobalState.Persistent.Cooldown
 import Concordium.GlobalState.Persistent.Instances (PersistentInstance (..), PersistentInstanceParameters (..), PersistentInstanceV (..))
 import qualified Concordium.GlobalState.Persistent.Instances as Instances
 import qualified Concordium.GlobalState.Persistent.LFMBTree as LFMBT
@@ -770,6 +771,7 @@ data BlockStatePointers (pv :: ProtocolVersion) = BlockStatePointers
       bspCryptographicParameters :: !(HashedBufferedRef CryptographicParameters),
       bspUpdates :: !(BufferedRef (Updates pv)),
       bspReleaseSchedule :: !(ReleaseSchedule pv),
+      bspAccountsInCooldown :: !(AccountsInCooldownForPV pv),
       bspTransactionOutcomes :: !(PersistentTransactionOutcomes (TransactionOutcomesVersionFor pv)),
       -- | Details of bakers that baked blocks in the current epoch. This is
       --  used for rewarding bakers at the end of epochs.
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Cooldown.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Cooldown.hs
index 5fee15ab6..8e63d0c75 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Cooldown.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Cooldown.hs
@@ -8,11 +8,32 @@
 
 module Concordium.GlobalState.Persistent.Cooldown where
 
+import Concordium.GlobalState.Persistent.BlobStore
 import Concordium.GlobalState.Persistent.ReleaseSchedule
 import Concordium.Types
+import Concordium.Types.Conditionally
 
+data AccountListItem = AccountListItem
+    { accountListEntry :: !AccountIndex,
+      accountListTail :: !AccountList
+    }
+
+type AccountList = Nullable (UnbufferedRef AccountListItem)
+
+-- | This is an indexing structure and therefore does not need to be hashed. FIXME: add more docs
 data AccountsInCooldown = AccountsInCooldown
     { cooldown :: NewReleaseSchedule,
       preCooldown :: [AccountIndex],
       prePreCooldown :: [AccountIndex]
     }
+
+type AccountsInCooldownForPV pv = (Conditionally (SupportsFlexibleCooldown (AccountVersionFor pv)) AccountsInCooldown)
+
+instance (MonadBlobStore m) => BlobStorable m AccountsInCooldown where
+    load = undefined
+
+    -- do
+    --   cooldown <- load
+    --   preCooldown <- load
+    --   return ()
+    storeUpdate = undefined

From 412d25371278b51f6863c6b3b946a96e0ab518b1 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Fri, 12 Apr 2024 16:52:34 +0200
Subject: [PATCH 06/81] Stake cooldown migration.

---
 concordium-base                               |   2 +-
 .../GlobalState/Persistent/Account.hs         |   3 +-
 .../Persistent/Account/MigrationState.hs      | 108 ++++++++++++
 .../Persistent/Account/StructureV1.hs         |   3 +-
 .../GlobalState/Persistent/Accounts.hs        |  20 ++-
 .../GlobalState/Persistent/BlockState.hs      | 126 +++++++-------
 .../GlobalState/Persistent/Cooldown.hs        | 154 ++++++++++++++++--
 .../GlobalState/Persistent/Genesis.hs         |   2 +
 .../GlobalState/Persistent/ReleaseSchedule.hs |  31 ++--
 9 files changed, 361 insertions(+), 88 deletions(-)
 create mode 100644 concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationState.hs

diff --git a/concordium-base b/concordium-base
index 6c4b85cf8..1939b2d8d 160000
--- a/concordium-base
+++ b/concordium-base
@@ -1 +1 @@
-Subproject commit 6c4b85cf8ed6b5deb5ae3d12d7bf534006342c03
+Subproject commit 1939b2d8ddbe81a4c04f8b0dcfda656bbcf3e9f3
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs
index 96575c1f0..71e917af4 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs
@@ -27,6 +27,7 @@ import Concordium.GlobalState.Account
 import Concordium.GlobalState.BakerInfo
 import qualified Concordium.GlobalState.Basic.BlockState.Account as Transient
 import Concordium.GlobalState.BlockState (AccountAllowance)
+import Concordium.GlobalState.Persistent.Account.MigrationState
 import qualified Concordium.GlobalState.Persistent.Account.StructureV0 as V0
 import qualified Concordium.GlobalState.Persistent.Account.StructureV1 as V1
 import Concordium.GlobalState.Persistent.BlobStore
@@ -570,7 +571,7 @@ migratePersistentAccount ::
     ) =>
     StateMigrationParameters oldpv pv ->
     PersistentAccount (AccountVersionFor oldpv) ->
-    t m (PersistentAccount (AccountVersionFor pv))
+    AccountMigrationStateTT oldpv pv t m (PersistentAccount (AccountVersionFor pv))
 migratePersistentAccount m@StateMigrationParametersTrivial (PAV0 acc) = PAV0 <$> V0.migratePersistentAccount m acc
 migratePersistentAccount m@StateMigrationParametersTrivial (PAV1 acc) = PAV1 <$> V0.migratePersistentAccount m acc
 migratePersistentAccount m@StateMigrationParametersTrivial (PAV2 acc) = PAV2 <$> V1.migratePersistentAccount m acc
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationState.hs
new file mode 100644
index 000000000..c0971ff3c
--- /dev/null
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationState.hs
@@ -0,0 +1,108 @@
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Concordium.GlobalState.Persistent.Account.MigrationState where
+
+import Control.Monad.IO.Class
+import Control.Monad.Trans
+import Control.Monad.Trans.State.Strict
+import Data.Bool.Singletons
+import Data.Kind
+import Lens.Micro.Platform
+
+import Concordium.Types
+import Concordium.Types.Conditionally
+
+import Concordium.GlobalState.Persistent.BlobStore
+import Concordium.GlobalState.Persistent.Cache
+import Concordium.GlobalState.Persistent.Cooldown
+import Control.Monad.State.Class
+
+newtype AccountMigrationState (oldpv :: ProtocolVersion) (pv :: ProtocolVersion) = AccountMigrationState
+    { -- | In the P6 -> P7 protocol update, this records the accounts that previously were in
+      --  cooldown, and now will be in pre-pre-cooldown.
+      _migrationPrePreCooldown ::
+        Conditionally
+            ( Not (SupportsFlexibleCooldown (AccountVersionFor oldpv))
+                && SupportsFlexibleCooldown (AccountVersionFor pv)
+            )
+            AccountList
+    }
+makeLenses ''AccountMigrationState
+
+-- | An 'AccountMigrationState' in an initial state.
+initialAccountMigrationState :: forall oldpv pv. (IsProtocolVersion oldpv, IsProtocolVersion pv) => AccountMigrationState oldpv pv
+initialAccountMigrationState = AccountMigrationState{..}
+  where
+    _migrationPrePreCooldown = case sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor oldpv)) of
+        SFalse -> case sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv)) of
+            SFalse -> CFalse
+            STrue -> CTrue Null
+        STrue -> CFalse
+
+newtype
+    AccountMigrationStateTT
+        (oldpv :: ProtocolVersion)
+        (pv :: ProtocolVersion)
+        (t :: (Type -> Type) -> (Type -> Type))
+        (m :: (Type -> Type))
+        (a :: Type) = AccountMigrationStateTT
+    { runAccountMigrationStateTT' ::
+        StateT (AccountMigrationState oldpv pv) (t m) a
+    }
+    deriving newtype (Functor, Applicative, Monad, MonadState (AccountMigrationState oldpv pv), MonadIO)
+
+runAccountMigrationStateTT :: AccountMigrationStateTT oldpv pv t m a -> AccountMigrationState oldpv pv -> t m (a, AccountMigrationState oldpv pv)
+runAccountMigrationStateTT = runStateT . runAccountMigrationStateTT'
+
+deriving via
+    forall
+        (oldpv :: ProtocolVersion)
+        (pv :: ProtocolVersion)
+        (t :: (Type -> Type) -> (Type -> Type))
+        (m :: (Type -> Type)).
+    ( StateT (AccountMigrationState oldpv pv) (t m)
+    )
+    instance
+        (MonadBlobStore (t m)) =>
+        (MonadBlobStore (AccountMigrationStateTT oldpv pv t m))
+
+deriving via
+    forall
+        (oldpv :: ProtocolVersion)
+        (pv :: ProtocolVersion)
+        (t :: (Type -> Type) -> (Type -> Type))
+        (m :: (Type -> Type)).
+    ( StateT (AccountMigrationState oldpv pv) (t m)
+    )
+    instance
+        (MonadCache c (t m)) =>
+        (MonadCache c (AccountMigrationStateTT oldpv pv t m))
+
+instance (MonadTrans t) => MonadTrans (AccountMigrationStateTT oldpv pv t) where
+    lift = AccountMigrationStateTT . lift . lift
+
+-- | Add an account to the set of accounts that should be considered in pre-pre-cooldown as part
+--  of migration. This only has an effect when transitioning from a protocol version that does not
+--  support flexible cooldown to one that does.
+addAccountInPrePreCooldown ::
+    (MonadBlobStore (t m)) =>
+    AccountIndex ->
+    AccountMigrationStateTT oldpv pv t m ()
+addAccountInPrePreCooldown ai = do
+    mmpc <- use migrationPrePreCooldown
+    case mmpc of
+        CTrue mpc -> do
+            newHead <-
+                makeUnbufferedRef
+                    AccountListItem
+                        { accountListEntry = ai,
+                          accountListTail = mpc
+                        }
+            migrationPrePreCooldown .= CTrue (Some newHead)
+        CFalse -> return ()
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
index 125be1261..22be3e020 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
@@ -39,6 +39,7 @@ import qualified Concordium.GlobalState.Basic.BlockState.AccountReleaseSchedule
 import qualified Concordium.GlobalState.Basic.BlockState.AccountReleaseScheduleV1 as TARSV1
 import Concordium.GlobalState.BlockState (AccountAllowance (..))
 import Concordium.GlobalState.Persistent.Account.EncryptedAmount
+import Concordium.GlobalState.Persistent.Account.MigrationState
 import qualified Concordium.GlobalState.Persistent.Account.StructureV0 as V0
 import Concordium.GlobalState.Persistent.BlobStore
 import qualified Concordium.GlobalState.Persistent.BlockState.AccountReleaseSchedule as ARSV0
@@ -1573,7 +1574,7 @@ migratePersistentAccount ::
     ) =>
     StateMigrationParameters oldpv pv ->
     PersistentAccount (AccountVersionFor oldpv) ->
-    t m (PersistentAccount (AccountVersionFor pv))
+    AccountMigrationStateTT oldpv pv t m (PersistentAccount (AccountVersionFor pv))
 migratePersistentAccount StateMigrationParametersTrivial acc = case accountVersion @(AccountVersionFor oldpv) of
     SAccountV2 -> migrateV2ToV2 acc
     SAccountV3 -> migrateV3ToV3 acc
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs
index 4a98b21c7..77c92e16d 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs
@@ -67,6 +67,7 @@ import qualified Concordium.GlobalState.AccountMap.LMDB as LMDBAccountMap
 import Concordium.GlobalState.BlockState (AccountsHash (..))
 import Concordium.GlobalState.Parameters
 import Concordium.GlobalState.Persistent.Account
+import Concordium.GlobalState.Persistent.Account.MigrationState
 import Concordium.GlobalState.Persistent.BlobStore
 import Concordium.GlobalState.Persistent.Cache
 import Concordium.GlobalState.Persistent.CachedRef
@@ -77,6 +78,7 @@ import qualified Concordium.ID.Types as ID
 import Concordium.Types
 import Concordium.Types.HashableTo
 import Concordium.Types.Option (Option (..))
+import Concordium.Utils
 import Control.Monad
 import Control.Monad.Reader
 import Data.Foldable (foldlM)
@@ -494,15 +496,23 @@ migrateAccounts ::
     ) =>
     StateMigrationParameters oldpv pv ->
     Accounts oldpv ->
-    t m (Accounts pv)
+    t m (Accounts pv, AccountMigrationState oldpv pv)
 migrateAccounts migration Accounts{..} = do
-    newAccountTable <- L.migrateLFMBTree (migrateHashedCachedRef' (migratePersistentAccount migration)) accountTable
+    (newAccountTable, migrationState) <-
+        runAccountMigrationStateTT
+            ( L.migrateLFMBTree
+                (migrateHashedCachedRef' (migratePersistentAccount migration))
+                accountTable
+            )
+            initialAccountMigrationState
     -- The account registration IDs are not cached. There is a separate cache
     -- that is purely in-memory and just copied over.
     newAccountRegIds <- Trie.migrateUnbufferedTrieN return accountRegIdHistory
-    return $!
-        Accounts
+    return $!!
+        ( Accounts
             { accountTable = newAccountTable,
               accountRegIdHistory = newAccountRegIds,
               accountDiffMapRef = accountDiffMapRef
-            }
+            },
+          migrationState
+        )
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
index 7e84612db..05436c126 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
@@ -832,6 +832,7 @@ instance (SupportsPersistentState pv m) => BlobStorable m (BlockStatePointers pv
         (poutcomes, bspTransactionOutcomes') <- storeUpdate bspTransactionOutcomes
         (pupdates, bspUpdates') <- storeUpdate bspUpdates
         (preleases, bspReleaseSchedule') <- storeUpdate bspReleaseSchedule
+        (pAccountsInCooldown, bspAccountInCooldown') <- storeUpdate bspAccountsInCooldown
         (pRewardDetails, bspRewardDetails') <- storeUpdate bspRewardDetails
         let putBSP = do
                 paccts
@@ -845,6 +846,7 @@ instance (SupportsPersistentState pv m) => BlobStorable m (BlockStatePointers pv
                 poutcomes
                 pupdates
                 preleases
+                pAccountsInCooldown
                 pRewardDetails
         return
             ( putBSP,
@@ -859,6 +861,7 @@ instance (SupportsPersistentState pv m) => BlobStorable m (BlockStatePointers pv
                   bspTransactionOutcomes = bspTransactionOutcomes',
                   bspUpdates = bspUpdates',
                   bspReleaseSchedule = bspReleaseSchedule',
+                  bspAccountsInCooldown = bspAccountInCooldown',
                   bspRewardDetails = bspRewardDetails'
                 }
             )
@@ -874,6 +877,7 @@ instance (SupportsPersistentState pv m) => BlobStorable m (BlockStatePointers pv
         moutcomes <- label "Transaction outcomes" load
         mUpdates <- label "Updates" load
         mReleases <- label "Release schedule" load
+        mAccountsInCooldown <- label "Accounts in cooldown" load
         mRewardDetails <- label "Epoch blocks" load
         return $! do
             bspAccounts <- maccts
@@ -886,6 +890,7 @@ instance (SupportsPersistentState pv m) => BlobStorable m (BlockStatePointers pv
             bspTransactionOutcomes <- moutcomes
             bspUpdates <- mUpdates
             bspReleaseSchedule <- mReleases
+            bspAccountsInCooldown <- mAccountsInCooldown
             bspRewardDetails <- mRewardDetails
             return $! BlockStatePointers{..}
 
@@ -898,6 +903,7 @@ bspPoolRewards bsp = case bspRewardDetails bsp of
     BlockRewardDetailsV1 pr -> pr
 
 -- | An initial 'HashedPersistentBlockState', which may be used for testing purposes.
+-- This assumes that among the initial accounts, none are in (pre)*cooldown.
 {-# WARNING initialPersistentState "should only be used for testing" #-}
 initialPersistentState ::
     forall pv m.
@@ -935,6 +941,7 @@ initialPersistentState seedState cryptoParams accounts ips ars keysCollection ch
                   bspTransactionOutcomes = emptyPersistentTransactionOutcomes,
                   bspUpdates = updates,
                   bspReleaseSchedule = releaseSchedule,
+                  bspAccountsInCooldown = emptyAccountsInCooldownForPV,
                   bspRewardDetails = red
                 }
     bps <- liftIO $ newIORef $! bsp
@@ -970,6 +977,7 @@ emptyBlockState bspBirkParameters cryptParams keysCollection chainParams = do
                   bspIdentityProviders = identityProviders,
                   bspAnonymityRevokers = anonymityRevokers,
                   bspCryptographicParameters = cryptographicParameters,
+                  bspAccountsInCooldown = emptyAccountsInCooldownForPV,
                   bspTransactionOutcomes = emptyTransactionOutcomes (Proxy @pv),
                   ..
                 }
@@ -1478,60 +1486,60 @@ doConfigureBaker pbs ai BakerConfigureAdd{..} = do
             let capitalMin = poolParams ^. ppMinimumEquityCapital
             let ranges = poolParams ^. ppCommissionBounds
             if
-                    | bcaCapital < capitalMin -> return (BCStakeUnderThreshold, pbs)
-                    | not (isInRange bcaTransactionFeeCommission (ranges ^. transactionCommissionRange)) ->
-                        return (BCTransactionFeeCommissionNotInRange, pbs)
-                    | not (isInRange bcaBakingRewardCommission (ranges ^. bakingCommissionRange)) ->
-                        return (BCBakingRewardCommissionNotInRange, pbs)
-                    | not (isInRange bcaFinalizationRewardCommission (ranges ^. finalizationCommissionRange)) ->
-                        return (BCFinalizationRewardCommissionNotInRange, pbs)
-                    | otherwise -> do
-                        let bid = BakerId ai
-                        pab <- refLoad (_birkActiveBakers (bspBirkParameters bsp))
-                        let updAgg Nothing = return (True, Trie.Insert ())
-                            updAgg (Just ()) = return (False, Trie.NoChange)
-                        Trie.adjust updAgg (bkuAggregationKey bcaKeys) (_aggregationKeys pab) >>= \case
-                            -- Aggregation key is a duplicate
-                            (False, _) -> return (BCDuplicateAggregationKey (bkuAggregationKey bcaKeys), pbs)
-                            (True, newAggregationKeys) -> do
-                                newActiveBakers <- Trie.insert bid emptyPersistentActiveDelegators (_activeBakers pab)
-                                newpabref <-
-                                    refMake
-                                        PersistentActiveBakers
-                                            { _aggregationKeys = newAggregationKeys,
-                                              _activeBakers = newActiveBakers,
-                                              _passiveDelegators = pab ^. passiveDelegators,
-                                              _totalActiveCapital = addActiveCapital bcaCapital (_totalActiveCapital pab)
-                                            }
-                                let newBirkParams = bspBirkParameters bsp & birkActiveBakers .~ newpabref
-                                let cr =
-                                        CommissionRates
-                                            { _finalizationCommission = bcaFinalizationRewardCommission,
-                                              _bakingCommission = bcaBakingRewardCommission,
-                                              _transactionCommission = bcaTransactionFeeCommission
-                                            }
-                                    poolInfo =
-                                        BaseAccounts.BakerPoolInfo
-                                            { _poolOpenStatus = bcaOpenForDelegation,
-                                              _poolMetadataUrl = bcaMetadataURL,
-                                              _poolCommissionRates = cr
-                                            }
-                                    bakerInfo = bakerKeyUpdateToInfo bid bcaKeys
-                                    bakerInfoEx =
-                                        BaseAccounts.BakerInfoExV1
-                                            { _bieBakerPoolInfo = poolInfo,
-                                              _bieBakerInfo = bakerInfo
-                                            }
-                                    updAcc = addAccountBakerV1 bakerInfoEx bcaCapital bcaRestakeEarnings
-                                -- This cannot fail to update the account, since we already looked up the account.
-                                newAccounts <- Accounts.updateAccountsAtIndex' updAcc ai (bspAccounts bsp)
-                                (BCSuccess [] bid,)
-                                    <$> storePBS
-                                        pbs
-                                        bsp
-                                            { bspBirkParameters = newBirkParams,
-                                              bspAccounts = newAccounts
-                                            }
+                | bcaCapital < capitalMin -> return (BCStakeUnderThreshold, pbs)
+                | not (isInRange bcaTransactionFeeCommission (ranges ^. transactionCommissionRange)) ->
+                    return (BCTransactionFeeCommissionNotInRange, pbs)
+                | not (isInRange bcaBakingRewardCommission (ranges ^. bakingCommissionRange)) ->
+                    return (BCBakingRewardCommissionNotInRange, pbs)
+                | not (isInRange bcaFinalizationRewardCommission (ranges ^. finalizationCommissionRange)) ->
+                    return (BCFinalizationRewardCommissionNotInRange, pbs)
+                | otherwise -> do
+                    let bid = BakerId ai
+                    pab <- refLoad (_birkActiveBakers (bspBirkParameters bsp))
+                    let updAgg Nothing = return (True, Trie.Insert ())
+                        updAgg (Just ()) = return (False, Trie.NoChange)
+                    Trie.adjust updAgg (bkuAggregationKey bcaKeys) (_aggregationKeys pab) >>= \case
+                        -- Aggregation key is a duplicate
+                        (False, _) -> return (BCDuplicateAggregationKey (bkuAggregationKey bcaKeys), pbs)
+                        (True, newAggregationKeys) -> do
+                            newActiveBakers <- Trie.insert bid emptyPersistentActiveDelegators (_activeBakers pab)
+                            newpabref <-
+                                refMake
+                                    PersistentActiveBakers
+                                        { _aggregationKeys = newAggregationKeys,
+                                          _activeBakers = newActiveBakers,
+                                          _passiveDelegators = pab ^. passiveDelegators,
+                                          _totalActiveCapital = addActiveCapital bcaCapital (_totalActiveCapital pab)
+                                        }
+                            let newBirkParams = bspBirkParameters bsp & birkActiveBakers .~ newpabref
+                            let cr =
+                                    CommissionRates
+                                        { _finalizationCommission = bcaFinalizationRewardCommission,
+                                          _bakingCommission = bcaBakingRewardCommission,
+                                          _transactionCommission = bcaTransactionFeeCommission
+                                        }
+                                poolInfo =
+                                    BaseAccounts.BakerPoolInfo
+                                        { _poolOpenStatus = bcaOpenForDelegation,
+                                          _poolMetadataUrl = bcaMetadataURL,
+                                          _poolCommissionRates = cr
+                                        }
+                                bakerInfo = bakerKeyUpdateToInfo bid bcaKeys
+                                bakerInfoEx =
+                                    BaseAccounts.BakerInfoExV1
+                                        { _bieBakerPoolInfo = poolInfo,
+                                          _bieBakerInfo = bakerInfo
+                                        }
+                                updAcc = addAccountBakerV1 bakerInfoEx bcaCapital bcaRestakeEarnings
+                            -- This cannot fail to update the account, since we already looked up the account.
+                            newAccounts <- Accounts.updateAccountsAtIndex' updAcc ai (bspAccounts bsp)
+                            (BCSuccess [] bid,)
+                                <$> storePBS
+                                    pbs
+                                    bsp
+                                        { bspBirkParameters = newBirkParams,
+                                          bspAccounts = newAccounts
+                                        }
 doConfigureBaker pbs ai BakerConfigureUpdate{..} = do
     origBSP <- loadPBS pbs
     cp <- lookupCurrentParameters (bspUpdates origBSP)
@@ -2219,8 +2227,8 @@ doMint pbs mint = do
             bspBank bsp
                 & unhashed
                     %~ (Rewards.totalGTU +~ mintTotal mint)
-                    . (Rewards.bakingRewardAccount +~ mintBakingReward mint)
-                    . (Rewards.finalizationRewardAccount +~ mintFinalizationReward mint)
+                        . (Rewards.bakingRewardAccount +~ mintBakingReward mint)
+                        . (Rewards.finalizationRewardAccount +~ mintFinalizationReward mint)
     let updAcc = addAccountAmount $ mintDevelopmentCharge mint
     foundationAccount <- (^. cpFoundationAccount) <$> lookupCurrentParameters (bspUpdates bsp)
     newAccounts <- Accounts.updateAccountsAtIndex' updAcc foundationAccount (bspAccounts bsp)
@@ -3739,6 +3747,7 @@ migrateBlockPointers migration BlockStatePointers{..} = do
             StateMigrationParametersP6ToP7{} -> RSMNewToNew
     newReleaseSchedule <- migrateReleaseSchedule rsMigration bspReleaseSchedule
     newAccounts <- Accounts.migrateAccounts migration bspAccounts
+    newAccountsInCooldown <- migrateAccountsInCooldownForPV undefined bspAccountsInCooldown
     newModules <- migrateHashedBufferedRef Modules.migrateModules bspModules
     modules <- refLoad newModules
     newInstances <- Instances.migrateInstances modules bspInstances
@@ -3770,6 +3779,7 @@ migrateBlockPointers migration BlockStatePointers{..} = do
               bspCryptographicParameters = newCryptographicParameters,
               bspUpdates = newUpdates,
               bspReleaseSchedule = newReleaseSchedule,
+              bspAccountsInCooldown = newAccountsInCooldown,
               bspTransactionOutcomes = newTransactionOutcomes,
               bspRewardDetails = newRewardDetails
             }
@@ -3812,6 +3822,7 @@ cacheState hpbs = do
     cryptoParams <- cache bspCryptographicParameters
     upds <- cache bspUpdates
     rels <- cache bspReleaseSchedule
+    cdowns <- cache bspAccountsInCooldown
     red <- cache bspRewardDetails
     _ <-
         storePBS (hpbsPointers hpbs) $!
@@ -3826,6 +3837,7 @@ cacheState hpbs = do
                   bspCryptographicParameters = cryptoParams,
                   bspUpdates = upds,
                   bspReleaseSchedule = rels,
+                  bspAccountsInCooldown = cdowns,
                   bspTransactionOutcomes = bspTransactionOutcomes,
                   bspRewardDetails = red
                 }
@@ -3865,6 +3877,7 @@ cacheStateAndGetTransactionTable hpbs = do
                 else return tt
     tt <- foldM updInTT TransactionTable.emptyTransactionTable [minBound ..]
     rels <- cache bspReleaseSchedule
+    cdowns <- cache bspAccountsInCooldown
     red <- cache bspRewardDetails
     _ <-
         storePBS
@@ -3880,6 +3893,7 @@ cacheStateAndGetTransactionTable hpbs = do
                   bspCryptographicParameters = cryptoParams,
                   bspUpdates = upds,
                   bspReleaseSchedule = rels,
+                  bspAccountsInCooldown = cdowns,
                   bspTransactionOutcomes = bspTransactionOutcomes,
                   bspRewardDetails = red
                 }
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Cooldown.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Cooldown.hs
index 8e63d0c75..037c05b23 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Cooldown.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Cooldown.hs
@@ -1,39 +1,167 @@
--- {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE ScopedTypeVariables #-}
--- {-# LANGUAGE StandaloneDeriving #-}
--- {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 
 module Concordium.GlobalState.Persistent.Cooldown where
 
+import Data.Bool.Singletons
+import Data.Serialize
+
 import Concordium.GlobalState.Persistent.BlobStore
 import Concordium.GlobalState.Persistent.ReleaseSchedule
 import Concordium.Types
 import Concordium.Types.Conditionally
 
+-- | An 'AccountIndex' and the (possibly empty) tail of the list.
 data AccountListItem = AccountListItem
     { accountListEntry :: !AccountIndex,
       accountListTail :: !AccountList
     }
 
+instance (MonadBlobStore m) => BlobStorable m AccountListItem where
+    load = do
+        mAccountListEntry <- load
+        mAccountListTail <- load
+        return (AccountListItem <$> mAccountListEntry <*> mAccountListTail)
+    storeUpdate ali = do
+        (pAccountListTail, newAccountListTail) <- storeUpdate (accountListTail ali)
+        return
+            ( put (accountListEntry ali) >> pAccountListTail,
+              ali{accountListTail = newAccountListTail}
+            )
+
+-- | A possibly empty list of 'AccountIndex'es, stored under 'UnbufferedRef's.
 type AccountList = Nullable (UnbufferedRef AccountListItem)
 
+-- | Migrate an 'AccountList' from one context to another.
+migrateAccountList :: (SupportMigration m t) => AccountList -> t m AccountList
+migrateAccountList Null = return Null
+migrateAccountList (Some ubRef) = do
+    Some <$> migrateReference migrateAccountListItem ubRef
+  where
+    migrateAccountListItem ali = do
+        newTail <- migrateAccountList (accountListTail ali)
+        return $! ali{accountListTail = newTail}
+
 -- | This is an indexing structure and therefore does not need to be hashed. FIXME: add more docs
 data AccountsInCooldown = AccountsInCooldown
-    { cooldown :: NewReleaseSchedule,
-      preCooldown :: [AccountIndex],
-      prePreCooldown :: [AccountIndex]
+    { cooldown :: !NewReleaseSchedule,
+      preCooldown :: !AccountList,
+      prePreCooldown :: !AccountList
     }
 
-type AccountsInCooldownForPV pv = (Conditionally (SupportsFlexibleCooldown (AccountVersionFor pv)) AccountsInCooldown)
+-- | The cacheable instance only caches the 'cooldown' field, since the
+--  'preCooldown' and 'prePreCooldown' are implemented using 'UnbufferedRef's (and so
+--  would have no benefit from caching).
+instance (MonadBlobStore m) => Cacheable m AccountsInCooldown where
+    cache aic = do
+        newCooldown <- cache (cooldown aic)
+        return aic{cooldown = newCooldown}
 
 instance (MonadBlobStore m) => BlobStorable m AccountsInCooldown where
-    load = undefined
+    load = do
+        cooldown <- load
+        preCooldown <- load
+        prePreCooldown <- load
+        return (AccountsInCooldown <$> cooldown <*> preCooldown <*> prePreCooldown)
+    storeUpdate aic = do
+        (pCooldown, newCooldown) <- storeUpdate (cooldown aic)
+        (pPreCooldown, newPreCooldown) <- storeUpdate (preCooldown aic)
+        (pPrePreCooldown, newPrePreCooldown) <- storeUpdate (prePreCooldown aic)
+        let putAIC = pCooldown >> pPreCooldown >> pPrePreCooldown
+        return
+            ( putAIC,
+              AccountsInCooldown
+                { cooldown = newCooldown,
+                  preCooldown = newPreCooldown,
+                  prePreCooldown = newPrePreCooldown
+                }
+            )
+
+-- | An 'AccountsInCooldown' with no accounts in (pre)*cooldown.
+emptyAccountsInCooldown :: AccountsInCooldown
+emptyAccountsInCooldown =
+    AccountsInCooldown
+        { cooldown = emptyNewReleaseSchedule,
+          preCooldown = Null,
+          prePreCooldown = Null
+        }
+
+-- | Migrate 'AccountsInCooldown' from one 'BlobStore' to another.
+migrateAccountsInCooldown ::
+    (SupportMigration m t) =>
+    AccountsInCooldown ->
+    t m AccountsInCooldown
+migrateAccountsInCooldown aic = do
+    newCooldown <- migrateNewReleaseSchedule (cooldown aic)
+    newPreCooldown <- migrateAccountList (preCooldown aic)
+    newPrePreCooldown <- migrateAccountList (prePreCooldown aic)
+    return $!
+        AccountsInCooldown
+            { cooldown = newCooldown,
+              preCooldown = newPreCooldown,
+              prePreCooldown = newPrePreCooldown
+            }
+
+newtype AccountsInCooldownForPV pv = AccountsInCooldownForPV
+    { theAccountsInCooldownForPV ::
+        Conditionally (SupportsFlexibleCooldown (AccountVersionFor pv)) AccountsInCooldown
+    }
+
+instance (MonadBlobStore m, IsProtocolVersion pv) => BlobStorable m (AccountsInCooldownForPV pv) where
+    load = case sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv)) of
+        SFalse -> return (return (AccountsInCooldownForPV CFalse))
+        STrue -> fmap (AccountsInCooldownForPV . CTrue) <$> load
+    storeUpdate aicPV@(AccountsInCooldownForPV CFalse) = do
+        return (return (), aicPV)
+    storeUpdate (AccountsInCooldownForPV (CTrue aic)) = do
+        (paic, aic') <- storeUpdate aic
+        return (paic, AccountsInCooldownForPV (CTrue aic'))
+
+-- | An 'AccountsInCooldownForPV' with no accounts in (pre)*cooldown.
+emptyAccountsInCooldownForPV ::
+    forall pv.
+    (IsProtocolVersion pv) =>
+    AccountsInCooldownForPV pv
+emptyAccountsInCooldownForPV =
+    AccountsInCooldownForPV (conditionally cond emptyAccountsInCooldown)
+  where
+    cond = sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv))
+
+instance (MonadBlobStore m) => Cacheable m (AccountsInCooldownForPV pv) where
+    cache = fmap AccountsInCooldownForPV . mapM cache . theAccountsInCooldownForPV
 
-    -- do
-    --   cooldown <- load
-    --   preCooldown <- load
-    --   return ()
-    storeUpdate = undefined
+-- | Migrate an 'AccountsInCooldownForPV'.
+--
+--   * If the new protocol version (@pv@) does not support flexible cooldown, then this just
+--     produces the 'emptyAccountsInCooldownForPV'.
+--
+--   * Otherwise, if the old protocol version (@oldpv@) does not support flexible cooldown, then
+--     this produces an 'emptyAccountsInCooldownForPV' but with the 'prePreCooldown' accounts set
+--     to the provided list.
+--
+--   * If both protocol versions support flexible cooldown, the 'AccountsInCooldown' structure is
+--     simply migrated across unchanged.
+migrateAccountsInCooldownForPV ::
+    forall oldpv pv t m.
+    (SupportMigration m t, IsProtocolVersion pv, IsProtocolVersion oldpv) =>
+    Conditionally
+        ( Not (SupportsFlexibleCooldown (AccountVersionFor oldpv))
+            && SupportsFlexibleCooldown (AccountVersionFor pv)
+        )
+        AccountList ->
+    AccountsInCooldownForPV oldpv ->
+    t m (AccountsInCooldownForPV pv)
+migrateAccountsInCooldownForPV =
+    case sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv)) of
+        SFalse -> \_ _ -> return emptyAccountsInCooldownForPV
+        STrue -> case sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor oldpv)) of
+            SFalse -> \(CTrue prePreCooldownAccts) _ ->
+                return
+                    ( AccountsInCooldownForPV
+                        (CTrue (emptyAccountsInCooldown{prePreCooldown = prePreCooldownAccts}))
+                    )
+            STrue -> \_ (AccountsInCooldownForPV (CTrue oldAIC)) ->
+                AccountsInCooldownForPV . CTrue <$> migrateAccountsInCooldown oldAIC
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Genesis.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Genesis.hs
index 6139f2861..0f8858682 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Genesis.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Genesis.hs
@@ -26,6 +26,7 @@ import qualified Concordium.GlobalState.Persistent.BlobStore as Blob
 import qualified Concordium.GlobalState.Persistent.BlockState as BS
 import qualified Concordium.GlobalState.Persistent.BlockState.Modules as Modules
 import qualified Concordium.GlobalState.Persistent.BlockState.Updates as Updates
+import qualified Concordium.GlobalState.Persistent.Cooldown as Cooldown
 import qualified Concordium.GlobalState.Persistent.Instances as Instances
 import qualified Concordium.GlobalState.Persistent.LFMBTree as LFMBT
 import qualified Concordium.GlobalState.Persistent.PoolRewards as Rewards
@@ -243,6 +244,7 @@ buildGenesisBlockState vcgp GenesisData.GenesisState{..} = do
                   bspTransactionOutcomes = BS.emptyPersistentTransactionOutcomes,
                   bspUpdates = updates,
                   bspReleaseSchedule = releaseSchedule,
+                  bspAccountsInCooldown = Cooldown.emptyAccountsInCooldownForPV,
                   bspRewardDetails = rewardDetails
                 }
     bps <- MTL.liftIO $ newIORef $! bsp
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/ReleaseSchedule.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/ReleaseSchedule.hs
index 0b4780927..ac003f4b8 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/ReleaseSchedule.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/ReleaseSchedule.hs
@@ -224,6 +224,24 @@ instance (MonadBlobStore m) => ReleaseScheduleOperations m NewReleaseSchedule wh
                         newMap <- Trie.delete minTS m
                         go (accum ++ Set.toList (theAccountSet accs)) newMap
 
+-- | A release schedule with no entries.
+emptyNewReleaseSchedule :: NewReleaseSchedule
+emptyNewReleaseSchedule =
+    NewReleaseSchedule
+        { nrsFirstTimestamp = Timestamp maxBound,
+          nrsMap = Trie.empty
+        }
+
+-- | Migrate a 'NewReleaseSchedule' from one 'BlobStore' to another.
+migrateNewReleaseSchedule :: (SupportMigration m t) => NewReleaseSchedule -> t m NewReleaseSchedule
+migrateNewReleaseSchedule rs = do
+    newMap <- Trie.migrateTrieN True return (nrsMap rs)
+    return $!
+        NewReleaseSchedule
+            { nrsFirstTimestamp = nrsFirstTimestamp rs,
+              nrsMap = newMap
+            }
+
 -- | A reference to an account used in the top-level release schedule.
 --  For protocol version prior to 'P5', this is 'AccountAddress', and for 'P5' onward this is
 --  'AccountIndex'. This type determines the implementation of the release schedule use for the
@@ -310,10 +328,7 @@ emptyReleaseSchedule = case protocolVersion @pv of
     rsP1 = do
         return $!
             ReleaseScheduleP5
-                NewReleaseSchedule
-                    { nrsFirstTimestamp = Timestamp maxBound,
-                      nrsMap = Trie.empty
-                    }
+                emptyNewReleaseSchedule
 
 -- | Migration information for a release schedule.
 data ReleaseScheduleMigration m oldpv pv where
@@ -372,13 +387,7 @@ migrateReleaseSchedule (RSMLegacyToNew resolveAcc) (ReleaseScheduleP0 rsRef) = d
                   nrsMap = newMap'
                 }
 migrateReleaseSchedule RSMNewToNew (ReleaseScheduleP5 rs) = do
-    newMap <- Trie.migrateTrieN True return (nrsMap rs)
-    return $!
-        ReleaseScheduleP5
-            NewReleaseSchedule
-                { nrsFirstTimestamp = nrsFirstTimestamp rs,
-                  nrsMap = newMap
-                }
+    ReleaseScheduleP5 <$> migrateNewReleaseSchedule rs
 
 -- | (For testing purposes) get the map of the earliest scheduled releases of each account.
 releasesMap ::

From 392d6876cc984aa46623aac936a5bceb4b3648f1 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Fri, 26 Apr 2024 14:39:44 +0200
Subject: [PATCH 07/81] CooldownQueue definitions an integration with account
 structure.

---
 concordium-base                               |   2 +-
 .../src/Concordium/GlobalState/Account.hs     |   4 -
 .../GlobalState/Basic/BlockState/Account.hs   |   2 +-
 .../Basic/BlockState/CooldownQueue.hs         | 168 +++++++++++++++
 .../Concordium/GlobalState/CooldownQueue.hs   |  69 +++++++
 .../Persistent/Account/CooldownQueue.hs       | 194 ++++++++++++++++++
 .../Persistent/Account/MigrationState.hs      |  17 +-
 .../Persistent/Account/StructureV0.hs         |   4 +-
 .../Persistent/Account/StructureV1.hs         |  79 ++++---
 .../GlobalState/Persistent/Accounts.hs        |   7 +-
 .../GlobalState/Persistent/BlockState.hs      |   8 +-
 .../GlobalState/Persistent/LFMBTree.hs        |   3 +-
 12 files changed, 513 insertions(+), 44 deletions(-)
 create mode 100644 concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/CooldownQueue.hs
 create mode 100644 concordium-consensus/src/Concordium/GlobalState/CooldownQueue.hs
 create mode 100644 concordium-consensus/src/Concordium/GlobalState/Persistent/Account/CooldownQueue.hs

diff --git a/concordium-base b/concordium-base
index 1939b2d8d..82511f6cb 160000
--- a/concordium-base
+++ b/concordium-base
@@ -1 +1 @@
-Subproject commit 1939b2d8ddbe81a4c04f8b0dcfda656bbcf3e9f3
+Subproject commit 82511f6cbe7ed59ce55c3d2967168131c875d946
diff --git a/concordium-consensus/src/Concordium/GlobalState/Account.hs b/concordium-consensus/src/Concordium/GlobalState/Account.hs
index cd9c13218..7b8ea107b 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Account.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Account.hs
@@ -27,7 +27,6 @@ import qualified Concordium.GlobalState.Basic.BlockState.AccountReleaseScheduleV
 import Concordium.ID.Types
 import Concordium.Types
 import Concordium.Types.Accounts
-import Concordium.Types.Accounts.CooldownQueue
 import Concordium.Types.Execution
 import Concordium.Types.HashableTo
 import Concordium.Utils.Serialization
@@ -35,9 +34,6 @@ import Concordium.Utils.Serialization
 newtype CooldownQueueHash (av :: AccountVersion) = CooldownQueueHash {theCooldownQueueHash :: Hash.Hash}
     deriving (Eq, Ord, Show, Serialize)
 
-instance HashableTo (CooldownQueueHash av) (CooldownQueue av) where
-    getHash _ = undefined
-
 -- | A list of credential IDs that have been removed from an account.
 data RemovedCredentials
     = EmptyRemovedCredentials
diff --git a/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/Account.hs b/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/Account.hs
index 789acb8b4..3e88dfd1b 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/Account.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/Account.hs
@@ -22,13 +22,13 @@ import Lens.Micro.Platform
 import qualified Concordium.Crypto.SHA256 as Hash
 import Concordium.GlobalState.Account
 import Concordium.GlobalState.Basic.BlockState.AccountReleaseSchedule
+import Concordium.GlobalState.Basic.BlockState.CooldownQueue
 import Concordium.ID.Parameters
 import Concordium.ID.Types
 import Concordium.Types.HashableTo
 
 import Concordium.Types
 import Concordium.Types.Accounts
-import Concordium.Types.Accounts.CooldownQueue
 
 -- | Type for how a 'PersistingAccountData' value is stored as part of
 --  an account. This is stored with its hash.
diff --git a/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/CooldownQueue.hs b/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/CooldownQueue.hs
new file mode 100644
index 000000000..25fac1437
--- /dev/null
+++ b/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/CooldownQueue.hs
@@ -0,0 +1,168 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Concordium.GlobalState.Basic.BlockState.CooldownQueue where
+
+import Data.Bool.Singletons
+import qualified Data.Map.Strict as Map
+import Data.Maybe
+import Data.Serialize
+
+import Concordium.Types
+import Concordium.Types.HashableTo
+
+import Concordium.GlobalState.Account
+import Concordium.GlobalState.CooldownQueue
+import Concordium.Types.Option
+
+-- | A 'CooldownQueue' records the inactive stake amounts that are due to be released in future.
+--  Note that prior to account version 3 (protocol version 7), the only value is the empty cooldown
+--  queue.
+data CooldownQueue (av :: AccountVersion) where
+    -- | The empty cooldown queue.
+    EmptyCooldownQueue :: CooldownQueue av
+    -- | A non-empty cooldown queue.
+    --  INVARIANT: The 'Cooldowns' must not satisfy 'isEmptyCooldowns'.
+    CooldownQueue ::
+        (SupportsFlexibleCooldown av ~ 'True) =>
+        !Cooldowns ->
+        CooldownQueue av
+
+deriving instance Show (CooldownQueue av)
+deriving instance Eq (CooldownQueue av)
+
+instance forall av. (IsAccountVersion av) => Serialize (CooldownQueue av) where
+    put = case sSupportsFlexibleCooldown (accountVersion @av) of
+        SFalse -> const (return ())
+        STrue -> \case
+            EmptyCooldownQueue -> putWord64be 0
+            CooldownQueue queue -> put queue
+    get = case sSupportsFlexibleCooldown (accountVersion @av) of
+        SFalse -> return EmptyCooldownQueue
+        STrue -> do
+            cooldowns <- get
+            return $!
+                if isEmptyCooldowns cooldowns
+                    then EmptyCooldownQueue
+                    else CooldownQueue cooldowns
+
+instance HashableTo (CooldownQueueHash av) (CooldownQueue av) where
+    getHash _ = undefined -- FIXME: Define
+
+-- | The empty 'CooldownQueue'.
+emptyCooldownQueue :: CooldownQueue av
+emptyCooldownQueue = EmptyCooldownQueue
+
+-- | Check if a 'CooldownQueue' is empty.
+isCooldownQueueEmpty :: CooldownQueue av -> Bool
+isCooldownQueueEmpty EmptyCooldownQueue = True
+isCooldownQueueEmpty _ = False
+
+-- | Convert a 'Cooldowns' to a 'CooldownQueue', using 'EmptyCooldownQueue' for the case where
+--  there are no cooldowns.
+fromCooldowns :: (SupportsFlexibleCooldown av ~ True) => Cooldowns -> CooldownQueue av
+fromCooldowns cooldowns
+    | isEmptyCooldowns cooldowns = emptyCooldownQueue
+    | otherwise = CooldownQueue cooldowns
+
+-- | Create an initial 'CooldownQueue' with only the given target amount set for pre-pre-cooldown.
+initialPrePreCooldownQueue :: (SupportsFlexibleCooldown av ~ True) => Amount -> CooldownQueue av
+initialPrePreCooldownQueue target =
+    CooldownQueue $
+        Cooldowns
+            { inCooldown = Map.empty,
+              preCooldownTargetStake = Absent,
+              prePreCooldownTargetStake = Present target
+            }
+
+-- | Process all cooldowns that expire at or before the given timestamp.
+--  If there are no such cooldowns, then 'Nothing' is returned.
+--  Otherwise, the total amount exiting cooldown and the remaining queue are returned.
+processCooldowns :: Timestamp -> CooldownQueue av -> Maybe (Amount, CooldownQueue av)
+processCooldowns _ EmptyCooldownQueue = Nothing
+processCooldowns ts (CooldownQueue queue)
+    | freeAmount == 0 = Nothing
+    | otherwise = Just (freeAmount, remainder)
+  where
+    freeAmount = sum free + sum bonus
+    (free, bonus, keep) = Map.splitLookup ts (inCooldown queue)
+    remainder = fromCooldowns (queue{inCooldown = keep})
+
+-- | Process the pre-cooldown (if any). The active stake is reduced to the new target stake, and
+-- the remaining stake is added to the cooldown queue.
+processPreCooldown ::
+    -- | Timestamp at which the cooldown should expire.
+    Timestamp ->
+    -- | Current active stake.
+    Amount ->
+    -- | Current cooldown queue.
+    CooldownQueue av ->
+    -- | If a change is required, the new active stake and cooldown queue.
+    Maybe (Amount, CooldownQueue av)
+processPreCooldown _ _ EmptyCooldownQueue = Nothing
+processPreCooldown ts stake (CooldownQueue cooldowns@Cooldowns{..}) =
+    ofOption Nothing (Just . cooldownWithTarget) preCooldownTargetStake
+  where
+    cooldownsNoPre = cooldowns{preCooldownTargetStake = Absent}
+    cooldownWithTarget targetStake
+        | stake == 0 || targetStake >= stake = (stake, fromCooldowns cooldownsNoPre)
+        | otherwise =
+            ( targetStake,
+              fromCooldowns
+                cooldownsNoPre
+                    { inCooldown = Map.alter (Just . (+ (stake - targetStake)) . fromMaybe 0) ts inCooldown
+                    }
+            )
+
+{-}
+-- | Move all pre-cooldowns into cooldown state. Where the pre-cooldown has a timestamp set, that
+-- is used. Otherwise, the timestamp is used. This returns 'Nothing' if the queue would not be
+-- changed, i.e. there are no pre-cooldowns.
+-- Note, this will predominantly be used when there is at most one pre-cooldown, and it has no
+-- timestamp set. Thus, this is not particularly optimized for other cases.
+processPreCooldown :: Timestamp -> Amount -> CooldownQueue av -> Maybe (Amount, CooldownQueue av)
+processPreCooldown _ _ EmptyCooldownQueue = Nothing
+processPreCooldown ts stake (CooldownQueue queue)
+    | null precooldowns = Nothing
+    | tsMillis ts > theCooldownTimeCode maxCooldownTimestampCode = error "Timestamp out of bounds"
+    | otherwise = Just (newStake, newQueue)
+  where
+    newQueue = CooldownQueue $ Map.unionsWith (+) [newCooldowns, preprecooldowns]
+    (cooldowns, rest) = Map.spanAntitone (<= maxCooldownTimestampCode) queue
+    (precooldowns, preprecooldowns) = Map.spanAntitone (<= encodeCooldownTime PreCooldown) rest
+    (newStake, newCooldowns) = Map.foldlWithKey' ff (stake, cooldowns) precooldowns
+    ff (staked, accCooldowns) tc amt
+        | staked == 0 = (staked, accCooldowns)
+        | staked < amt = (staked, accCooldowns)
+        | otherwise = (amt, Map.alter (Just . (+ (staked - amt)) . fromMaybe 0) (f tc) accCooldowns)
+    f c@(CooldownTimeCode code)
+        | c == encodeCooldownTime PreCooldown = CooldownTimeCode $ tsMillis ts
+        | otherwise = CooldownTimeCode (Bits.clearBit code 63)
+
+-- | Get the next timestamp (if any) at which a cooldown is scheduled to elapse.
+nextCooldownTime :: CooldownQueue av -> Maybe Timestamp
+nextCooldownTime EmptyCooldownQueue = Nothing
+nextCooldownTime (CooldownQueue queue) = case decodeCooldownTime minEntry of
+    CooldownTimestamp ts -> Just ts
+    _ -> Nothing
+  where
+    -- This is safe because 'CooldownQueue' requires @queue@ to be non-empty.
+    (minEntry, _) = Map.findMin queue
+
+-- | Check if a 'CooldownQueue' has any pre-cooldown entries.
+hasPreCooldown :: CooldownQueue av -> Bool
+hasPreCooldown EmptyCooldownQueue = False
+hasPreCooldown (CooldownQueue queue) = case Map.lookupGT maxCooldownTimestampCode queue of
+    Just (x, _) -> x <= encodeCooldownTime PreCooldown
+    Nothing -> False
+
+-- | Check if a 'CooldownQueue' has any pre-pre-cooldown entries.
+hasPrePreCooldown :: CooldownQueue av -> Bool
+hasPrePreCooldown EmptyCooldownQueue = False
+hasPrePreCooldown (CooldownQueue queue) = isJust $ Map.lookupGT (encodeCooldownTime PreCooldown) queue
+-}
diff --git a/concordium-consensus/src/Concordium/GlobalState/CooldownQueue.hs b/concordium-consensus/src/Concordium/GlobalState/CooldownQueue.hs
new file mode 100644
index 000000000..387c84e3a
--- /dev/null
+++ b/concordium-consensus/src/Concordium/GlobalState/CooldownQueue.hs
@@ -0,0 +1,69 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Concordium.GlobalState.CooldownQueue where
+
+import qualified Data.Bits as Bits
+import qualified Data.Map.Strict as Map
+import Data.Serialize
+
+import Concordium.Types
+import Concordium.Utils.Serialization
+
+import Concordium.GlobalState.Persistent.BlobStore
+import Concordium.Types.Option
+
+-- | The amounts that are currently in cooldown and any pre-cooldown and pre-pre-cooldown target
+-- balances.
+data Cooldowns = Cooldowns
+    { -- | Amounts currently in cooldown.
+      -- (Must have fewer than 2^62 entries.)
+      inCooldown :: !(Map.Map Timestamp Amount),
+      -- | The target staked balance after the next payday.
+      --  If 'Nothing', there is no change.
+      preCooldownTargetStake :: !(Option Amount),
+      -- | The target staked balance after the next payday after the next epoch transition.
+      --  If 'Nothing', there is no change.
+      prePreCooldownTargetStake :: !(Option Amount)
+    }
+    deriving (Eq, Show)
+
+instance Serialize Cooldowns where
+    put Cooldowns{..} = do
+        putWord64be tag
+        putSafeSizedMapOf put put inCooldown
+        mapM_ put preCooldownTargetStake
+        mapM_ put prePreCooldownTargetStake
+      where
+        -- The two highest order bits encode whether there is a preCooldownTargetStake and a
+        -- prePreCooldownTargetStake
+        tag = fromIntegral (Map.size inCooldown) Bits..|. preCooldownBit Bits..|. prePreCooldownBit
+        preCooldownBit
+            | isPresent preCooldownTargetStake = Bits.bit 62
+            | otherwise = 0
+        prePreCooldownBit
+            | isPresent prePreCooldownTargetStake = Bits.bit 63
+            | otherwise = 0
+    get :: Get Cooldowns
+    get = do
+        tag <- getWord64be
+        inCooldown <- getSafeSizedMapOf (tag Bits..&. sizeMask) get get
+        preCooldownTargetStake <- if Bits.testBit tag 62 then Present <$> get else return Absent
+        prePreCooldownTargetStake <- if Bits.testBit tag 63 then Present <$> get else return Absent
+        return Cooldowns{..}
+      where
+        sizeMask = Bits.bit 62 - 1
+
+instance (MonadBlobStore m) => BlobStorable m Cooldowns
+
+-- | Check if a 'Cooldowns' is empty (i.e. has no stake in cooldown, pre-cooldown or
+--  pre-pre-cooldown).
+isEmptyCooldowns :: Cooldowns -> Bool
+isEmptyCooldowns Cooldowns{..} =
+    Map.null inCooldown
+        && null preCooldownTargetStake
+        && null prePreCooldownTargetStake
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/CooldownQueue.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/CooldownQueue.hs
new file mode 100644
index 000000000..a1240fec7
--- /dev/null
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/CooldownQueue.hs
@@ -0,0 +1,194 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Concordium.GlobalState.Persistent.Account.CooldownQueue where
+
+import Data.Bool.Singletons
+import Data.Functor
+import qualified Data.Map.Strict as Map
+
+import Concordium.Types
+import Concordium.Types.HashableTo
+import Concordium.Utils
+
+import Concordium.GlobalState.Account
+import qualified Concordium.GlobalState.Basic.BlockState.CooldownQueue as Transient
+import Concordium.GlobalState.CooldownQueue
+import Concordium.GlobalState.Persistent.BlobStore
+import Concordium.Types.Option
+
+-- | A 'CooldownQueue' records the inactive stake amounts that are due to be released in future.
+--  Note that prior to account version 3 (protocol version 7), the only value is the empty cooldown
+--  queue.
+data CooldownQueue (av :: AccountVersion) where
+    -- | The empty cooldown queue.
+    EmptyCooldownQueue :: CooldownQueue av
+    -- | A non-empty cooldown queue.
+    --  INVARIANT: The 'Cooldowns' must not satisfy 'isEmptyCooldowns'.
+    CooldownQueue ::
+        (SupportsFlexibleCooldown av ~ 'True) =>
+        !(EagerBufferedRef Cooldowns) ->
+        CooldownQueue av
+
+deriving instance Show (CooldownQueue av)
+
+instance forall m av. (MonadBlobStore m, IsAccountVersion av) => BlobStorable m (CooldownQueue av) where
+    load = case sSupportsFlexibleCooldown (accountVersion @av) of
+        SFalse -> return $ return EmptyCooldownQueue
+        STrue -> do
+            mRef <- load
+            return $!
+                mRef <&> \case
+                    Null -> EmptyCooldownQueue
+                    Some cooldowns -> CooldownQueue cooldowns
+    storeUpdate = case sSupportsFlexibleCooldown (accountVersion @av) of
+        SFalse -> \queue -> return (return (), queue)
+        STrue -> \queue -> do
+            (putter, nRef) <- storeUpdate (asNullable queue)
+            return $!! (putter, ofNullable nRef)
+      where
+        asNullable :: CooldownQueue av -> Nullable (EagerBufferedRef Cooldowns)
+        asNullable EmptyCooldownQueue = Null
+        asNullable (CooldownQueue queue) = Some queue
+        ofNullable Null = EmptyCooldownQueue
+        ofNullable (Some queue) = CooldownQueue queue
+
+instance HashableTo (CooldownQueueHash av) (CooldownQueue av) where
+    getHash _ = undefined -- FIXME: Define
+
+-- | The empty 'CooldownQueue'.
+emptyCooldownQueue :: CooldownQueue av
+emptyCooldownQueue = EmptyCooldownQueue
+
+-- | Check if a 'CooldownQueue' is empty.
+isCooldownQueueEmpty :: CooldownQueue av -> Bool
+isCooldownQueueEmpty EmptyCooldownQueue = True
+isCooldownQueueEmpty _ = False
+
+makePersistentCooldownQueue ::
+    (MonadBlobStore m) =>
+    Transient.CooldownQueue av ->
+    m (CooldownQueue av)
+makePersistentCooldownQueue Transient.EmptyCooldownQueue = return EmptyCooldownQueue
+makePersistentCooldownQueue (Transient.CooldownQueue queue) = CooldownQueue <$> refMake queue
+
+toTransientCooldownQueue :: CooldownQueue av -> Transient.CooldownQueue av
+toTransientCooldownQueue EmptyCooldownQueue = Transient.EmptyCooldownQueue
+toTransientCooldownQueue (CooldownQueue queueRef) =
+    Transient.CooldownQueue (eagerBufferedDeref queueRef)
+
+-- | Create an initial 'CooldownQueue' with only the given target amount set for pre-pre-cooldown.
+initialPrePreCooldownQueue :: (MonadBlobStore m, SupportsFlexibleCooldown av ~ True) => Amount -> m (CooldownQueue av)
+initialPrePreCooldownQueue target =
+    CooldownQueue
+        <$> refMake
+            Cooldowns
+                { inCooldown = Map.empty,
+                  preCooldownTargetStake = Absent,
+                  prePreCooldownTargetStake = Present target
+                }
+
+-- | Migrate a cooldown queue unchanged.
+migrateCooldownQueue :: forall m t av. (SupportMigration m t) => CooldownQueue av -> t m (CooldownQueue av)
+migrateCooldownQueue EmptyCooldownQueue = return EmptyCooldownQueue
+migrateCooldownQueue (CooldownQueue queueRef) =
+    CooldownQueue <$> migrateEagerBufferedRef return queueRef
+
+{-
+-- | Convert a 'Cooldowns' to a 'CooldownQueue', using 'EmptyCooldownQueue' for the case where
+--  there are no cooldowns.
+fromCooldowns :: (SupportsFlexibleCooldown av ~ True) => Cooldowns -> CooldownQueue av
+fromCooldowns cooldowns
+    | isEmptyCooldowns cooldowns = emptyCooldownQueue
+    | otherwise = CooldownQueue cooldowns
+
+-- | Process all cooldowns that expire at or before the given timestamp.
+--  If there are no such cooldowns, then 'Nothing' is returned.
+--  Otherwise, the total amount exiting cooldown and the remaining queue are returned.
+processCooldowns :: Timestamp -> CooldownQueue av -> Maybe (Amount, CooldownQueue av)
+processCooldowns _ EmptyCooldownQueue = Nothing
+processCooldowns ts (CooldownQueue queue)
+    | freeAmount == 0 = Nothing
+    | otherwise = Just (freeAmount, remainder)
+  where
+    freeAmount = sum free + sum bonus
+    (free, bonus, keep) = Map.splitLookup ts (inCooldown queue)
+    remainder = fromCooldowns (queue{inCooldown = keep})
+
+-- | Process the pre-cooldown (if any). The active stake is reduced to the new target stake, and
+-- the remaining stake is added to the cooldown queue.
+processPreCooldown ::
+    -- | Timestamp at which the cooldown should expire.
+    Timestamp ->
+    -- | Current active stake.
+    Amount ->
+    -- | Current cooldown queue.
+    CooldownQueue av ->
+    -- | If a change is required, the new active stake and cooldown queue.
+    Maybe (Amount, CooldownQueue av)
+processPreCooldown _ _ EmptyCooldownQueue = Nothing
+processPreCooldown ts stake (CooldownQueue cooldowns@Cooldowns{..}) =
+    ofOption Nothing (Just . cooldownWithTarget) preCooldownTargetStake
+  where
+    cooldownsNoPre = cooldowns{preCooldownTargetStake = Absent}
+    cooldownWithTarget targetStake
+        | stake == 0 || targetStake >= stake = (stake, fromCooldowns cooldownsNoPre)
+        | otherwise =
+            ( targetStake,
+              fromCooldowns
+                cooldownsNoPre
+                    { inCooldown = Map.alter (Just . (+ (stake - targetStake)) . fromMaybe 0) ts inCooldown
+                    }
+            )
+
+-- | Move all pre-cooldowns into cooldown state. Where the pre-cooldown has a timestamp set, that
+-- is used. Otherwise, the timestamp is used. This returns 'Nothing' if the queue would not be
+-- changed, i.e. there are no pre-cooldowns.
+-- Note, this will predominantly be used when there is at most one pre-cooldown, and it has no
+-- timestamp set. Thus, this is not particularly optimized for other cases.
+processPreCooldown :: Timestamp -> Amount -> CooldownQueue av -> Maybe (Amount, CooldownQueue av)
+processPreCooldown _ _ EmptyCooldownQueue = Nothing
+processPreCooldown ts stake (CooldownQueue queue)
+    | null precooldowns = Nothing
+    | tsMillis ts > theCooldownTimeCode maxCooldownTimestampCode = error "Timestamp out of bounds"
+    | otherwise = Just (newStake, newQueue)
+  where
+    newQueue = CooldownQueue $ Map.unionsWith (+) [newCooldowns, preprecooldowns]
+    (cooldowns, rest) = Map.spanAntitone (<= maxCooldownTimestampCode) queue
+    (precooldowns, preprecooldowns) = Map.spanAntitone (<= encodeCooldownTime PreCooldown) rest
+    (newStake, newCooldowns) = Map.foldlWithKey' ff (stake, cooldowns) precooldowns
+    ff (staked, accCooldowns) tc amt
+        | staked == 0 = (staked, accCooldowns)
+        | staked < amt = (staked, accCooldowns)
+        | otherwise = (amt, Map.alter (Just . (+ (staked - amt)) . fromMaybe 0) (f tc) accCooldowns)
+    f c@(CooldownTimeCode code)
+        | c == encodeCooldownTime PreCooldown = CooldownTimeCode $ tsMillis ts
+        | otherwise = CooldownTimeCode (Bits.clearBit code 63)
+
+-- | Get the next timestamp (if any) at which a cooldown is scheduled to elapse.
+nextCooldownTime :: CooldownQueue av -> Maybe Timestamp
+nextCooldownTime EmptyCooldownQueue = Nothing
+nextCooldownTime (CooldownQueue queue) = case decodeCooldownTime minEntry of
+    CooldownTimestamp ts -> Just ts
+    _ -> Nothing
+  where
+    -- This is safe because 'CooldownQueue' requires @queue@ to be non-empty.
+    (minEntry, _) = Map.findMin queue
+
+-- | Check if a 'CooldownQueue' has any pre-cooldown entries.
+hasPreCooldown :: CooldownQueue av -> Bool
+hasPreCooldown EmptyCooldownQueue = False
+hasPreCooldown (CooldownQueue queue) = case Map.lookupGT maxCooldownTimestampCode queue of
+    Just (x, _) -> x <= encodeCooldownTime PreCooldown
+    Nothing -> False
+
+-- | Check if a 'CooldownQueue' has any pre-pre-cooldown entries.
+hasPrePreCooldown :: CooldownQueue av -> Bool
+hasPrePreCooldown EmptyCooldownQueue = False
+hasPrePreCooldown (CooldownQueue queue) = isJust $ Map.lookupGT (encodeCooldownTime PreCooldown) queue
+-}
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationState.hs
index c0971ff3c..fe561fd4f 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationState.hs
@@ -21,17 +21,21 @@ import Concordium.Types.Conditionally
 import Concordium.GlobalState.Persistent.BlobStore
 import Concordium.GlobalState.Persistent.Cache
 import Concordium.GlobalState.Persistent.Cooldown
+import Concordium.Utils
 import Control.Monad.State.Class
 
-newtype AccountMigrationState (oldpv :: ProtocolVersion) (pv :: ProtocolVersion) = AccountMigrationState
+data AccountMigrationState (oldpv :: ProtocolVersion) (pv :: ProtocolVersion) = AccountMigrationState
     { -- | In the P6 -> P7 protocol update, this records the accounts that previously were in
       --  cooldown, and now will be in pre-pre-cooldown.
       _migrationPrePreCooldown ::
-        Conditionally
+        !( Conditionally
             ( Not (SupportsFlexibleCooldown (AccountVersionFor oldpv))
                 && SupportsFlexibleCooldown (AccountVersionFor pv)
             )
             AccountList
+         ),
+      -- | A counter to track the index of the current account as we traverse the account table.
+      _currentAccountIndex :: !AccountIndex
     }
 makeLenses ''AccountMigrationState
 
@@ -44,6 +48,7 @@ initialAccountMigrationState = AccountMigrationState{..}
             SFalse -> CFalse
             STrue -> CTrue Null
         STrue -> CFalse
+    _currentAccountIndex = 0
 
 newtype
     AccountMigrationStateTT
@@ -92,9 +97,9 @@ instance (MonadTrans t) => MonadTrans (AccountMigrationStateTT oldpv pv t) where
 --  support flexible cooldown to one that does.
 addAccountInPrePreCooldown ::
     (MonadBlobStore (t m)) =>
-    AccountIndex ->
     AccountMigrationStateTT oldpv pv t m ()
-addAccountInPrePreCooldown ai = do
+addAccountInPrePreCooldown = do
+    ai <- use currentAccountIndex
     mmpc <- use migrationPrePreCooldown
     case mmpc of
         CTrue mpc -> do
@@ -106,3 +111,7 @@ addAccountInPrePreCooldown ai = do
                         }
             migrationPrePreCooldown .= CTrue (Some newHead)
         CFalse -> return ()
+
+-- | Increment the current account index.
+nextAccount :: (Monad (t m)) => AccountMigrationStateTT oldpv pv t m ()
+nextAccount = currentAccountIndex %=! (+ 1)
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV0.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV0.hs
index a04bdc7b9..e288fa321 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV0.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV0.hs
@@ -43,13 +43,13 @@ import Concordium.GlobalState.BakerInfo (BakerAdd (..), BakerKeyUpdate (..), bak
 import qualified Concordium.GlobalState.Basic.BlockState.Account as Transient
 import qualified Concordium.GlobalState.Basic.BlockState.AccountReleaseSchedule as Transient
 import qualified Concordium.GlobalState.Basic.BlockState.AccountReleaseScheduleV0 as ARSV0
+import qualified Concordium.GlobalState.Basic.BlockState.CooldownQueue as Transient
 import Concordium.GlobalState.BlockState
 import Concordium.GlobalState.Parameters
 import Concordium.GlobalState.Persistent.Account.EncryptedAmount
 import Concordium.GlobalState.Persistent.BlobStore
 import Concordium.GlobalState.Persistent.BlockState.AccountReleaseSchedule
 import Concordium.GlobalState.Persistent.CachedRef
-import Concordium.Types.Accounts.CooldownQueue
 
 -- * A note on 'Cacheable' instances for persistent accounts
 
@@ -1206,5 +1206,5 @@ toTransientAccount PersistentAccount{..} = do
         PersistentAccountStakeNone -> return AccountStakeNone
         PersistentAccountStakeBaker bkr -> AccountStakeBaker <$> (loadPersistentAccountBaker =<< refLoad bkr)
         PersistentAccountStakeDelegate dlg -> AccountStakeDelegate <$> refLoad dlg
-    let _accountStakeCooldown = emptyCooldownQueue
+    let _accountStakeCooldown = Transient.emptyCooldownQueue
     return $ Transient.Account{..}
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
index 22be3e020..33af3921c 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
@@ -26,6 +26,7 @@ import qualified Concordium.Crypto.SHA256 as Hash
 import Concordium.ID.Types hiding (values)
 import Concordium.Types
 import Concordium.Types.Accounts
+import Concordium.Types.Accounts.Releases
 import Concordium.Types.Execution
 import Concordium.Types.HashableTo
 import Concordium.Types.Parameters
@@ -38,6 +39,7 @@ import qualified Concordium.GlobalState.Basic.BlockState.Account as Transient
 import qualified Concordium.GlobalState.Basic.BlockState.AccountReleaseSchedule as TARS
 import qualified Concordium.GlobalState.Basic.BlockState.AccountReleaseScheduleV1 as TARSV1
 import Concordium.GlobalState.BlockState (AccountAllowance (..))
+import Concordium.GlobalState.Persistent.Account.CooldownQueue
 import Concordium.GlobalState.Persistent.Account.EncryptedAmount
 import Concordium.GlobalState.Persistent.Account.MigrationState
 import qualified Concordium.GlobalState.Persistent.Account.StructureV0 as V0
@@ -45,8 +47,6 @@ import Concordium.GlobalState.Persistent.BlobStore
 import qualified Concordium.GlobalState.Persistent.BlockState.AccountReleaseSchedule as ARSV0
 import Concordium.GlobalState.Persistent.BlockState.AccountReleaseScheduleV1
 import Concordium.ID.Parameters
-import Concordium.Types.Accounts.CooldownQueue
-import Concordium.Types.Accounts.Releases
 import Control.Monad.Trans
 import qualified Data.Map.Strict as Map
 
@@ -185,7 +185,8 @@ persistentToAccountStake PersistentAccountStakeEnduringDelegator{..} _delegation
                   ..
                 }
 
--- | Migrate a 'PersistentAccountStakeEnduring' from one blob store to another.
+-- | Migrate a 'PersistentAccountStakeEnduring' from one blob store to another, where the account
+--  version is unchanged.
 migratePersistentAccountStakeEnduring ::
     (SupportMigration m t, IsAccountVersion av) =>
     PersistentAccountStakeEnduring av ->
@@ -202,22 +203,30 @@ migratePersistentAccountStakeEnduring PersistentAccountStakeEnduringBaker{..} =
 migratePersistentAccountStakeEnduring PersistentAccountStakeEnduringDelegator{..} =
     return $! PersistentAccountStakeEnduringDelegator{..}
 
+-- | Migrate a 'PersistentAccountStakeEnduring' from 'AccountV2' to 'AccountV3'.
+--  If a cooldown is in effect on the account, then the pending change is removed and returned.
+--  The idea is that the target stake will become the pre-pre-cooldown target on migration.
 migratePersistentAccountStakeEnduringV2toV3 ::
     (SupportMigration m t) =>
     PersistentAccountStakeEnduring 'AccountV2 ->
-    t m (PersistentAccountStakeEnduring 'AccountV3)
+    t m (PersistentAccountStakeEnduring 'AccountV3, StakePendingChange 'AccountV2)
 migratePersistentAccountStakeEnduringV2toV3 PersistentAccountStakeEnduringNone =
-    return PersistentAccountStakeEnduringNone
+    return (PersistentAccountStakeEnduringNone, NoChange)
 migratePersistentAccountStakeEnduringV2toV3 PersistentAccountStakeEnduringBaker{..} = do
-    newBakerInfo <- migrateReference (return . coerceBakerInfoEx) paseBakerInfo
-    return $!
-        PersistentAccountStakeEnduringBaker
+    newBakerInfo <- migrateReference (return . coerceBakerInfoExV1) paseBakerInfo
+    return $!!
+        ( PersistentAccountStakeEnduringBaker
             { paseBakerInfo = newBakerInfo,
               paseBakerPendingChange = NoChange,
               ..
-            }
+            },
+          paseBakerPendingChange
+        )
 migratePersistentAccountStakeEnduringV2toV3 PersistentAccountStakeEnduringDelegator{..} =
-    return $! PersistentAccountStakeEnduringDelegator{paseDelegatorPendingChange = NoChange, ..}
+    return $!!
+        ( PersistentAccountStakeEnduringDelegator{paseDelegatorPendingChange = NoChange, ..},
+          paseDelegatorPendingChange
+        )
 
 -- | This relies on the fact that the 'AccountV2' hashing of 'AccountStake' is independent of the
 --  staked amount.
@@ -263,7 +272,7 @@ data PersistentAccountEnduringData (av :: AccountVersion) = PersistentAccountEnd
       -- | The staking details associated with the account.
       paedStake :: !(PersistentAccountStakeEnduring av),
       -- | The cooldown.
-      paedStakeCooldown :: !(CooldownQueue av) -- FIXME: Figure out whether this should be a ref.
+      paedStakeCooldown :: !(CooldownQueue av)
     }
 
 -- | Get the locked amount from a 'PersistingAccountEnduringData'.
@@ -1350,6 +1359,7 @@ makePersistentAccount Transient.Account{..} = do
                 rsRef <- refMake $! rs
                 let !lockedBal = _accountReleaseSchedule ^. TARS.totalLockedUpBalance
                 return (Some (rsRef, lockedBal))
+    paedStakeCooldown <- makePersistentCooldownQueue _accountStakeCooldown
     accountEnduringData <-
         refMake
             =<< case accountVersion @av of
@@ -1365,7 +1375,7 @@ makePersistentAccount Transient.Account{..} = do
                         paedEncryptedAmount
                         paedReleaseSchedule
                         paedStake
-                        _accountStakeCooldown
+                        paedStakeCooldown
     return $!
         PersistentAccount
             { accountNonce = _accountNonce,
@@ -1463,12 +1473,11 @@ makeFromGenesisAccount spv cryptoParams chainParameters GenesisAccount{..} = do
 
 -- ** Migration
 
--- | Migration for 'PersistentAccountEnduringData'. Only supports 'AccountV2'.
-migrateEnduringData ::
+migrateEnduringDataV2 ::
     (SupportMigration m t) =>
     PersistentAccountEnduringData 'AccountV2 ->
     t m (PersistentAccountEnduringData 'AccountV2)
-migrateEnduringData ed = do
+migrateEnduringDataV2 ed = do
     paedPersistingData <- migrateEagerBufferedRef return (paedPersistingData ed)
     paedEncryptedAmount <- forM (paedEncryptedAmount ed) $ migrateReference migratePersistentEncryptedAmount
     paedReleaseSchedule <- forM (paedReleaseSchedule ed) $ \(oldRSRef, lockedAmt) -> do
@@ -1482,20 +1491,28 @@ migrateEnduringData ed = do
               ..
             }
 
+-- | Migrate enduring data from 'AccountV2' to 'AccountV3'. If there was a stake cooldown in effect,
+--  that is migrated to a pre-pre-cooldown in the new state.
 migrateEnduringDataV2toV3 ::
     (SupportMigration m t) =>
     PersistentAccountEnduringData 'AccountV2 ->
-    t m (PersistentAccountEnduringData 'AccountV3)
+    AccountMigrationStateTT oldpv pv t m (PersistentAccountEnduringData 'AccountV3)
 migrateEnduringDataV2toV3 ed = do
     paedPersistingData <- migrateEagerBufferedRef return (paedPersistingData ed)
     paedEncryptedAmount <- forM (paedEncryptedAmount ed) $ migrateReference migratePersistentEncryptedAmount
     paedReleaseSchedule <- forM (paedReleaseSchedule ed) $ \(oldRSRef, lockedAmt) -> do
         newRSRef <- migrateReference migrateAccountReleaseSchedule oldRSRef
         return (newRSRef, lockedAmt)
-    paedStake <- migratePersistentAccountStakeEnduringV2toV3 (paedStake ed)
-    let paedStakeCooldown = undefined -- FIXME: fix
+    (paedStake, oldPendingChange) <- migratePersistentAccountStakeEnduringV2toV3 (paedStake ed)
+    -- On migration, anything that is currently in cooldown we move to pre-pre-cooldown.
+    paedStakeCooldown <- case oldPendingChange of
+        NoChange -> return emptyCooldownQueue
+        ReduceStake target _ -> addAccountInPrePreCooldown >> initialPrePreCooldownQueue target
+        RemoveStake _ -> addAccountInPrePreCooldown >> initialPrePreCooldownQueue 0
     makeAccountEnduringDataAV3 paedPersistingData paedEncryptedAmount paedReleaseSchedule paedStake paedStakeCooldown
 
+-- | Migration for 'PersistentAccountEnduringData'. Only supports 'AccountV3'.
+--  The data is unchanged in the migration.
 migrateEnduringDataV3toV3 ::
     (SupportMigration m t) =>
     PersistentAccountEnduringData 'AccountV3 ->
@@ -1507,13 +1524,11 @@ migrateEnduringDataV3toV3 ed = do
         newRSRef <- migrateReference migrateAccountReleaseSchedule oldRSRef
         return (newRSRef, lockedAmt)
     paedStake <- migratePersistentAccountStakeEnduring (paedStake ed)
-    -- FIXME: migrate the stake cooldown correctly if the type of 'paedStakeCooldown' changes.
-    makeAccountEnduringDataAV3 paedPersistingData paedEncryptedAmount paedReleaseSchedule paedStake (paedStakeCooldown ed :: CooldownQueue 'AccountV3)
+    paedStakeCooldown <- migrateCooldownQueue (paedStakeCooldown ed)
+    makeAccountEnduringDataAV3 paedPersistingData paedEncryptedAmount paedReleaseSchedule paedStake paedStakeCooldown
 
--- | A trivial migration from account version 2 to
---  account version 2.
---  In particular this function only migrates the underlying reference to
---  the 'PersistentAccountEnduringData'.
+-- | A trivial migration from account version 2 to account version 2.
+--  In particular the data is retained as-is.
 migrateV2ToV2 ::
     ( MonadBlobStore m,
       MonadBlobStore (t m),
@@ -1522,7 +1537,7 @@ migrateV2ToV2 ::
     PersistentAccount 'AccountV2 ->
     t m (PersistentAccount 'AccountV2)
 migrateV2ToV2 acc = do
-    accountEnduringData <- migrateEagerBufferedRef migrateEnduringData (accountEnduringData acc)
+    accountEnduringData <- migrateEagerBufferedRef migrateEnduringDataV2 (accountEnduringData acc)
     return $!
         PersistentAccount
             { accountNonce = accountNonce acc,
@@ -1531,15 +1546,21 @@ migrateV2ToV2 acc = do
               ..
             }
 
+-- | Migrate from account version 2 to account version 3.
+--  Stake cooldowns are migrated to being in pre-pre-cooldown.
+--  Otherwise, the state is unchanged on migration.
 migrateV2ToV3 ::
     ( MonadBlobStore m,
       MonadBlobStore (t m),
       MonadTrans t
     ) =>
     PersistentAccount 'AccountV2 ->
-    t m (PersistentAccount 'AccountV3)
+    AccountMigrationStateTT oldpv pv t m (PersistentAccount 'AccountV3)
 migrateV2ToV3 acc = do
-    accountEnduringData <- migrateEagerBufferedRef migrateEnduringDataV2toV3 (accountEnduringData acc)
+    accountEnduringData <-
+        migrateEagerBufferedRef
+            migrateEnduringDataV2toV3
+            (accountEnduringData acc)
     return $!
         PersistentAccount
             { accountNonce = accountNonce acc,
@@ -1548,6 +1569,8 @@ migrateV2ToV3 acc = do
               ..
             }
 
+-- | A trivial migration from account version 3 to account version 3.
+--  In particular the data is retained as-is.
 migrateV3ToV3 ::
     ( MonadBlobStore m,
       MonadBlobStore (t m),
@@ -1668,7 +1691,7 @@ toTransientAccount acc = do
     _accountEncryptedAmount <- getEncryptedAmount acc
     _accountReleaseSchedule <- getReleaseSchedule acc
     _accountStaking <- getStake acc
-    _accountStakeCooldown <- getStakeCooldown acc
+    _accountStakeCooldown <- toTransientCooldownQueue <$> getStakeCooldown acc
     return $
         Transient.Account
             { _accountNonce = accountNonce acc,
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs
index 77c92e16d..753db8b38 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs
@@ -498,10 +498,15 @@ migrateAccounts ::
     Accounts oldpv ->
     t m (Accounts pv, AccountMigrationState oldpv pv)
 migrateAccounts migration Accounts{..} = do
+    let migrateAccount acct = do
+            newAcct <- migrateHashedCachedRef' (migratePersistentAccount migration) acct
+            -- Increment the account index counter.
+            nextAccount
+            return newAcct
     (newAccountTable, migrationState) <-
         runAccountMigrationStateTT
             ( L.migrateLFMBTree
-                (migrateHashedCachedRef' (migratePersistentAccount migration))
+                migrateAccount
                 accountTable
             )
             initialAccountMigrationState
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
index 05436c126..88fac15f4 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
@@ -49,6 +49,7 @@ import Concordium.GlobalState.CapitalDistribution
 import qualified Concordium.GlobalState.ContractStateV1 as StateV1
 import Concordium.GlobalState.Parameters
 import Concordium.GlobalState.Persistent.Account
+import qualified Concordium.GlobalState.Persistent.Account.MigrationState as MigrationState
 import Concordium.GlobalState.Persistent.Accounts (SupportsPersistentAccount)
 import qualified Concordium.GlobalState.Persistent.Accounts as Accounts
 import qualified Concordium.GlobalState.Persistent.Accounts as LMDBAccountMap
@@ -3746,8 +3747,11 @@ migrateBlockPointers migration BlockStatePointers{..} = do
             StateMigrationParametersP5ToP6{} -> RSMNewToNew
             StateMigrationParametersP6ToP7{} -> RSMNewToNew
     newReleaseSchedule <- migrateReleaseSchedule rsMigration bspReleaseSchedule
-    newAccounts <- Accounts.migrateAccounts migration bspAccounts
-    newAccountsInCooldown <- migrateAccountsInCooldownForPV undefined bspAccountsInCooldown
+    (newAccounts, migrationState) <- Accounts.migrateAccounts migration bspAccounts
+    newAccountsInCooldown <-
+        migrateAccountsInCooldownForPV
+            (MigrationState._migrationPrePreCooldown migrationState)
+            bspAccountsInCooldown
     newModules <- migrateHashedBufferedRef Modules.migrateModules bspModules
     modules <- refLoad newModules
     newInstances <- Instances.migrateInstances modules bspInstances
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/LFMBTree.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/LFMBTree.hs
index b61965926..dfa627d11 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/LFMBTree.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/LFMBTree.hs
@@ -487,7 +487,8 @@ mmap_ f (NonEmpty _ t) = mmap_T t
         mmap_T =<< refLoad r
 
 -- | Migrate a LFMBTree from one context to the other. The new tree is cached in
--- memory and written to disk.
+-- memory and written to disk. Accounts are migrated in order of increasing account
+-- index.
 migrateLFMBTree ::
     forall m t ref1 ref2 v1 v2 k.
     (CanStoreLFMBTree m ref1 v1, Reference (t m) ref2 (T ref2 v2), MonadTrans t) =>

From cb060d101b8a12b73b17b4c2c55c0f17cdd5428e Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Thu, 2 May 2024 15:48:00 +0200
Subject: [PATCH 08/81] Restructuring cooldown implementation. Towards
 migration.

---
 concordium-base                               |  2 +-
 .../Basic/BlockState/CooldownQueue.hs         | 37 +++----
 .../Concordium/GlobalState/CooldownQueue.hs   | 35 +++----
 .../GlobalState/Persistent/Account.hs         |  7 +-
 .../Persistent/Account/CooldownQueue.hs       | 12 ++-
 .../Persistent/Account/MigrationState.hs      | 81 +++++++++++-----
 .../Account/MigrationStateInterface.hs        | 21 ++++
 .../Persistent/Account/StructureV1.hs         | 96 ++++++++++++-------
 .../GlobalState/Persistent/Accounts.hs        | 60 +++++++++++-
 .../GlobalState/Persistent/Bakers.hs          | 60 +++++-------
 .../GlobalState/Persistent/BlockState.hs      | 49 +++++++++-
 .../src/Concordium/Scheduler.hs               |  1 +
 12 files changed, 310 insertions(+), 151 deletions(-)
 create mode 100644 concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationStateInterface.hs

diff --git a/concordium-base b/concordium-base
index 82511f6cb..567616074 160000
--- a/concordium-base
+++ b/concordium-base
@@ -1 +1 @@
-Subproject commit 82511f6cbe7ed59ce55c3d2967168131c875d946
+Subproject commit 567616074177297ea8533693c8ec8f1397afb564
diff --git a/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/CooldownQueue.hs b/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/CooldownQueue.hs
index 25fac1437..c595ddfaf 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/CooldownQueue.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/CooldownQueue.hs
@@ -76,8 +76,8 @@ initialPrePreCooldownQueue target =
     CooldownQueue $
         Cooldowns
             { inCooldown = Map.empty,
-              preCooldownTargetStake = Absent,
-              prePreCooldownTargetStake = Present target
+              preCooldown = Absent,
+              prePreCooldown = Present target
             }
 
 -- | Process all cooldowns that expire at or before the given timestamp.
@@ -93,31 +93,24 @@ processCooldowns ts (CooldownQueue queue)
     (free, bonus, keep) = Map.splitLookup ts (inCooldown queue)
     remainder = fromCooldowns (queue{inCooldown = keep})
 
--- | Process the pre-cooldown (if any). The active stake is reduced to the new target stake, and
--- the remaining stake is added to the cooldown queue.
+-- | Process the pre-cooldown (if any). Any pre-cooldown amount is added to the cooldown queue
+--  with the specified expiry time.
 processPreCooldown ::
     -- | Timestamp at which the cooldown should expire.
     Timestamp ->
-    -- | Current active stake.
-    Amount ->
     -- | Current cooldown queue.
     CooldownQueue av ->
-    -- | If a change is required, the new active stake and cooldown queue.
-    Maybe (Amount, CooldownQueue av)
-processPreCooldown _ _ EmptyCooldownQueue = Nothing
-processPreCooldown ts stake (CooldownQueue cooldowns@Cooldowns{..}) =
-    ofOption Nothing (Just . cooldownWithTarget) preCooldownTargetStake
-  where
-    cooldownsNoPre = cooldowns{preCooldownTargetStake = Absent}
-    cooldownWithTarget targetStake
-        | stake == 0 || targetStake >= stake = (stake, fromCooldowns cooldownsNoPre)
-        | otherwise =
-            ( targetStake,
-              fromCooldowns
-                cooldownsNoPre
-                    { inCooldown = Map.alter (Just . (+ (stake - targetStake)) . fromMaybe 0) ts inCooldown
-                    }
-            )
+    -- | If a change is required, the new cooldown queue.
+    Maybe (CooldownQueue av)
+processPreCooldown _ EmptyCooldownQueue = Nothing
+processPreCooldown _ (CooldownQueue Cooldowns{preCooldown = Absent}) = Nothing
+processPreCooldown ts (CooldownQueue cdns@Cooldowns{preCooldown = Present newCooldownAmt, ..}) =
+    Just $
+        CooldownQueue $
+            cdns
+                { preCooldown = Absent,
+                  inCooldown = Map.alter (Just . (newCooldownAmt +) . fromMaybe 0) ts inCooldown
+                }
 
 {-}
 -- | Move all pre-cooldowns into cooldown state. Where the pre-cooldown has a timestamp set, that
diff --git a/concordium-consensus/src/Concordium/GlobalState/CooldownQueue.hs b/concordium-consensus/src/Concordium/GlobalState/CooldownQueue.hs
index 387c84e3a..523cd3f39 100644
--- a/concordium-consensus/src/Concordium/GlobalState/CooldownQueue.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/CooldownQueue.hs
@@ -23,12 +23,15 @@ data Cooldowns = Cooldowns
     { -- | Amounts currently in cooldown.
       -- (Must have fewer than 2^62 entries.)
       inCooldown :: !(Map.Map Timestamp Amount),
-      -- | The target staked balance after the next payday.
-      --  If 'Nothing', there is no change.
-      preCooldownTargetStake :: !(Option Amount),
-      -- | The target staked balance after the next payday after the next epoch transition.
-      --  If 'Nothing', there is no change.
-      prePreCooldownTargetStake :: !(Option Amount)
+      -- | The amount in pre-cooldown.
+      --  This will enter cooldown at the next payday.
+      --  If 'Nothing', there is no pre-cooldown.
+      preCooldown :: !(Option Amount),
+      -- | The amount in pre-pre-cooldown.
+      --  This will enter pre-cooldown at the next epoch transition that is one epoch before a
+      --  payday.
+      --  If 'Nothing', there is no pre-pre-cooldown.
+      prePreCooldown :: !(Option Amount)
     }
     deriving (Eq, Show)
 
@@ -36,24 +39,24 @@ instance Serialize Cooldowns where
     put Cooldowns{..} = do
         putWord64be tag
         putSafeSizedMapOf put put inCooldown
-        mapM_ put preCooldownTargetStake
-        mapM_ put prePreCooldownTargetStake
+        mapM_ put preCooldown
+        mapM_ put prePreCooldown
       where
-        -- The two highest order bits encode whether there is a preCooldownTargetStake and a
-        -- prePreCooldownTargetStake
+        -- The two highest order bits encode whether there is a preCooldown and a
+        -- prePreCooldown
         tag = fromIntegral (Map.size inCooldown) Bits..|. preCooldownBit Bits..|. prePreCooldownBit
         preCooldownBit
-            | isPresent preCooldownTargetStake = Bits.bit 62
+            | isPresent preCooldown = Bits.bit 62
             | otherwise = 0
         prePreCooldownBit
-            | isPresent prePreCooldownTargetStake = Bits.bit 63
+            | isPresent prePreCooldown = Bits.bit 63
             | otherwise = 0
     get :: Get Cooldowns
     get = do
         tag <- getWord64be
         inCooldown <- getSafeSizedMapOf (tag Bits..&. sizeMask) get get
-        preCooldownTargetStake <- if Bits.testBit tag 62 then Present <$> get else return Absent
-        prePreCooldownTargetStake <- if Bits.testBit tag 63 then Present <$> get else return Absent
+        preCooldown <- if Bits.testBit tag 62 then Present <$> get else return Absent
+        prePreCooldown <- if Bits.testBit tag 63 then Present <$> get else return Absent
         return Cooldowns{..}
       where
         sizeMask = Bits.bit 62 - 1
@@ -65,5 +68,5 @@ instance (MonadBlobStore m) => BlobStorable m Cooldowns
 isEmptyCooldowns :: Cooldowns -> Bool
 isEmptyCooldowns Cooldowns{..} =
     Map.null inCooldown
-        && null preCooldownTargetStake
-        && null prePreCooldownTargetStake
+        && null preCooldown
+        && null prePreCooldown
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs
index 71e917af4..879368c5d 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs
@@ -27,7 +27,7 @@ import Concordium.GlobalState.Account
 import Concordium.GlobalState.BakerInfo
 import qualified Concordium.GlobalState.Basic.BlockState.Account as Transient
 import Concordium.GlobalState.BlockState (AccountAllowance)
-import Concordium.GlobalState.Persistent.Account.MigrationState
+import Concordium.GlobalState.Persistent.Account.MigrationStateInterface
 import qualified Concordium.GlobalState.Persistent.Account.StructureV0 as V0
 import qualified Concordium.GlobalState.Persistent.Account.StructureV1 as V1
 import Concordium.GlobalState.Persistent.BlobStore
@@ -567,11 +567,12 @@ migratePersistentAccount ::
     forall oldpv pv t m.
     ( IsProtocolVersion oldpv,
       IsProtocolVersion pv,
-      SupportMigration m t
+      SupportMigration m t,
+      AccountMigration (AccountVersionFor pv) (t m)
     ) =>
     StateMigrationParameters oldpv pv ->
     PersistentAccount (AccountVersionFor oldpv) ->
-    AccountMigrationStateTT oldpv pv t m (PersistentAccount (AccountVersionFor pv))
+    t m (PersistentAccount (AccountVersionFor pv))
 migratePersistentAccount m@StateMigrationParametersTrivial (PAV0 acc) = PAV0 <$> V0.migratePersistentAccount m acc
 migratePersistentAccount m@StateMigrationParametersTrivial (PAV1 acc) = PAV1 <$> V0.migratePersistentAccount m acc
 migratePersistentAccount m@StateMigrationParametersTrivial (PAV2 acc) = PAV2 <$> V1.migratePersistentAccount m acc
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/CooldownQueue.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/CooldownQueue.hs
index a1240fec7..3ac85092e 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/CooldownQueue.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/CooldownQueue.hs
@@ -82,15 +82,19 @@ toTransientCooldownQueue EmptyCooldownQueue = Transient.EmptyCooldownQueue
 toTransientCooldownQueue (CooldownQueue queueRef) =
     Transient.CooldownQueue (eagerBufferedDeref queueRef)
 
--- | Create an initial 'CooldownQueue' with only the given target amount set for pre-pre-cooldown.
-initialPrePreCooldownQueue :: (MonadBlobStore m, SupportsFlexibleCooldown av ~ True) => Amount -> m (CooldownQueue av)
+-- | Create an initial 'CooldownQueue' with only the given amount set in pre-pre-cooldown.
+initialPrePreCooldownQueue ::
+    (MonadBlobStore m, SupportsFlexibleCooldown av ~ True) =>
+    -- | Initial amount in pre-pre-cooldown.
+    Amount ->
+    m (CooldownQueue av)
 initialPrePreCooldownQueue target =
     CooldownQueue
         <$> refMake
             Cooldowns
                 { inCooldown = Map.empty,
-                  preCooldownTargetStake = Absent,
-                  prePreCooldownTargetStake = Present target
+                  preCooldown = Absent,
+                  prePreCooldown = Present target
                 }
 
 -- | Migrate a cooldown queue unchanged.
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationState.hs
index fe561fd4f..b4fe1ca76 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationState.hs
@@ -5,24 +5,29 @@
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE UndecidableInstances #-}
 
 module Concordium.GlobalState.Persistent.Account.MigrationState where
 
 import Control.Monad.IO.Class
+import Control.Monad.State.Class
 import Control.Monad.Trans
 import Control.Monad.Trans.State.Strict
 import Data.Bool.Singletons
 import Data.Kind
+import Data.Maybe
 import Lens.Micro.Platform
 
 import Concordium.Types
 import Concordium.Types.Conditionally
+import Concordium.Utils
 
+import Concordium.GlobalState.Persistent.Account.MigrationStateInterface
+import Concordium.GlobalState.Persistent.Bakers as Bakers
 import Concordium.GlobalState.Persistent.BlobStore
 import Concordium.GlobalState.Persistent.Cache
 import Concordium.GlobalState.Persistent.Cooldown
-import Concordium.Utils
-import Control.Monad.State.Class
+import qualified Concordium.GlobalState.Persistent.Trie as Trie
 
 data AccountMigrationState (oldpv :: ProtocolVersion) (pv :: ProtocolVersion) = AccountMigrationState
     { -- | In the P6 -> P7 protocol update, this records the accounts that previously were in
@@ -34,14 +39,29 @@ data AccountMigrationState (oldpv :: ProtocolVersion) (pv :: ProtocolVersion) =
             )
             AccountList
          ),
+      -- | When migrating to P7 (and onwards), we will build up the 'PersistentActiveBakers' while
+      --  traversing the account table. This should be initialised with the active bakers (that
+      --  survive migration) but no delegators.
+      _persistentActiveBakers ::
+        !( Conditionally
+            (SupportsFlexibleCooldown (AccountVersionFor pv))
+            (PersistentActiveBakers (AccountVersionFor pv))
+         ),
       -- | A counter to track the index of the current account as we traverse the account table.
       _currentAccountIndex :: !AccountIndex
     }
 makeLenses ''AccountMigrationState
 
 -- | An 'AccountMigrationState' in an initial state.
-initialAccountMigrationState :: forall oldpv pv. (IsProtocolVersion oldpv, IsProtocolVersion pv) => AccountMigrationState oldpv pv
-initialAccountMigrationState = AccountMigrationState{..}
+initialAccountMigrationState ::
+    forall oldpv pv.
+    (IsProtocolVersion oldpv, IsProtocolVersion pv) =>
+    -- | The active bakers without the delegators.
+    Conditionally
+        (SupportsFlexibleCooldown (AccountVersionFor pv))
+        (PersistentActiveBakers (AccountVersionFor pv)) ->
+    AccountMigrationState oldpv pv
+initialAccountMigrationState _removedBakers = AccountMigrationState{..}
   where
     _migrationPrePreCooldown = case sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor oldpv)) of
         SFalse -> case sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv)) of
@@ -49,6 +69,10 @@ initialAccountMigrationState = AccountMigrationState{..}
             STrue -> CTrue Null
         STrue -> CFalse
     _currentAccountIndex = 0
+    _persistentActiveBakers =
+        conditionally
+            (sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv)))
+            emptyPersistentActiveBakers
 
 newtype
     AccountMigrationStateTT
@@ -92,26 +116,31 @@ deriving via
 instance (MonadTrans t) => MonadTrans (AccountMigrationStateTT oldpv pv t) where
     lift = AccountMigrationStateTT . lift . lift
 
--- | Add an account to the set of accounts that should be considered in pre-pre-cooldown as part
---  of migration. This only has an effect when transitioning from a protocol version that does not
---  support flexible cooldown to one that does.
-addAccountInPrePreCooldown ::
-    (MonadBlobStore (t m)) =>
-    AccountMigrationStateTT oldpv pv t m ()
-addAccountInPrePreCooldown = do
-    ai <- use currentAccountIndex
-    mmpc <- use migrationPrePreCooldown
-    case mmpc of
-        CTrue mpc -> do
-            newHead <-
-                makeUnbufferedRef
-                    AccountListItem
-                        { accountListEntry = ai,
-                          accountListTail = mpc
-                        }
-            migrationPrePreCooldown .= CTrue (Some newHead)
-        CFalse -> return ()
+instance
+    (MonadBlobStore (t m), IsProtocolVersion pv, av ~ AccountVersionFor pv) =>
+    AccountMigration av (AccountMigrationStateTT oldpv pv t m)
+    where
+    addAccountInPrePreCooldown = do
+        ai <- use currentAccountIndex
+        mmpc <- use migrationPrePreCooldown
+        case mmpc of
+            CTrue mpc -> do
+                newHead <-
+                    makeUnbufferedRef
+                        AccountListItem
+                            { accountListEntry = ai,
+                              accountListTail = mpc
+                            }
+                migrationPrePreCooldown .= CTrue (Some newHead)
+            CFalse -> return ()
+
+    nextAccount = currentAccountIndex %=! (+ 1)
+
+    isBakerRemoved bakerId =
+        use persistentActiveBakers >>= \case
+            CFalse -> return False
+            CTrue pab ->
+                isNothing <$> Trie.lookup bakerId (pab ^. activeBakers)
 
--- | Increment the current account index.
-nextAccount :: (Monad (t m)) => AccountMigrationStateTT oldpv pv t m ()
-nextAccount = currentAccountIndex %=! (+ 1)
+    addDelegator delId delAmt delTarget = do
+        undefined
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationStateInterface.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationStateInterface.hs
new file mode 100644
index 000000000..4b6cbeaa7
--- /dev/null
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationStateInterface.hs
@@ -0,0 +1,21 @@
+module Concordium.GlobalState.Persistent.Account.MigrationStateInterface where
+
+import Concordium.Types
+import Concordium.Types.Execution
+
+class AccountMigration (av :: AccountVersion) m | m -> av where
+    -- | Add the current account to the set of accounts that should be considered in
+    --  pre-pre-cooldown as part of migration. This only has an effect when transitioning from a
+    --  protocol version that does not support flexible cooldown to one that does.
+    addAccountInPrePreCooldown :: m ()
+
+    -- | Progress to the next sequential account index.
+    nextAccount :: m ()
+
+    -- | Query if the given 'BakerId' is set to be removed in this migration.
+    --  (The result is unspecified if the 'BakerId' was not a baker prior to migration.)
+    isBakerRemoved :: BakerId -> m Bool
+
+    -- | Add a delegator, delegating a specified amount to a delegation target.
+    --  The delegator must not already have been added.
+    addDelegator :: (AVSupportsDelegation av) => DelegatorId -> Amount -> DelegationTarget -> m ()
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
index 33af3921c..c898265d0 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
@@ -16,8 +16,11 @@
 module Concordium.GlobalState.Persistent.Account.StructureV1 where
 
 import Control.Monad
+import Control.Monad.Trans
+import qualified Control.Monad.Trans.State.Strict as State
 import Data.Bits
 import Data.Foldable
+import qualified Data.Map.Strict as Map
 import Data.Serialize
 import Data.Word
 import Lens.Micro.Platform
@@ -41,14 +44,12 @@ import qualified Concordium.GlobalState.Basic.BlockState.AccountReleaseScheduleV
 import Concordium.GlobalState.BlockState (AccountAllowance (..))
 import Concordium.GlobalState.Persistent.Account.CooldownQueue
 import Concordium.GlobalState.Persistent.Account.EncryptedAmount
-import Concordium.GlobalState.Persistent.Account.MigrationState
+import Concordium.GlobalState.Persistent.Account.MigrationStateInterface
 import qualified Concordium.GlobalState.Persistent.Account.StructureV0 as V0
 import Concordium.GlobalState.Persistent.BlobStore
 import qualified Concordium.GlobalState.Persistent.BlockState.AccountReleaseSchedule as ARSV0
 import Concordium.GlobalState.Persistent.BlockState.AccountReleaseScheduleV1
 import Concordium.ID.Parameters
-import Control.Monad.Trans
-import qualified Data.Map.Strict as Map
 
 -- * Terminology
 
@@ -209,24 +210,38 @@ migratePersistentAccountStakeEnduring PersistentAccountStakeEnduringDelegator{..
 migratePersistentAccountStakeEnduringV2toV3 ::
     (SupportMigration m t) =>
     PersistentAccountStakeEnduring 'AccountV2 ->
-    t m (PersistentAccountStakeEnduring 'AccountV3, StakePendingChange 'AccountV2)
+    -- | Returns the new 'PersistentAccountStakeEnduring' and the new stake if it changes as a
+    -- result of entering cooldown.
+    t m (PersistentAccountStakeEnduring 'AccountV3, Maybe Amount)
 migratePersistentAccountStakeEnduringV2toV3 PersistentAccountStakeEnduringNone =
-    return (PersistentAccountStakeEnduringNone, NoChange)
-migratePersistentAccountStakeEnduringV2toV3 PersistentAccountStakeEnduringBaker{..} = do
-    newBakerInfo <- migrateReference (return . coerceBakerInfoExV1) paseBakerInfo
-    return $!!
-        ( PersistentAccountStakeEnduringBaker
-            { paseBakerInfo = newBakerInfo,
-              paseBakerPendingChange = NoChange,
-              ..
-            },
-          paseBakerPendingChange
-        )
+    return (PersistentAccountStakeEnduringNone, Nothing)
+migratePersistentAccountStakeEnduringV2toV3 PersistentAccountStakeEnduringBaker{..} =
+    case paseBakerPendingChange of
+        RemoveStake _ -> do
+            -- The baker is being removed, so we don't migrate it.
+            return (PersistentAccountStakeEnduringNone, Just 0)
+        ReduceStake amt _ -> (,Just amt) <$> keepBakerInfo
+        NoChange -> (,Nothing) <$> keepBakerInfo
+  where
+    keepBakerInfo = do
+        newBakerInfo <- migrateReference (return . coerceBakerInfoExV1) paseBakerInfo
+        return
+            PersistentAccountStakeEnduringBaker
+                { paseBakerInfo = newBakerInfo,
+                  paseBakerPendingChange = NoChange,
+                  ..
+                }
 migratePersistentAccountStakeEnduringV2toV3 PersistentAccountStakeEnduringDelegator{..} =
-    return $!!
-        ( PersistentAccountStakeEnduringDelegator{paseDelegatorPendingChange = NoChange, ..},
-          paseDelegatorPendingChange
-        )
+    case paseDelegatorPendingChange of
+        RemoveStake _ -> return (PersistentAccountStakeEnduringNone, Just 0)
+        ReduceStake amt _ -> return $!! (newDelegatorInfo, Just amt)
+        NoChange -> return $!! (newDelegatorInfo, Nothing)
+  where
+    newDelegatorInfo =
+        PersistentAccountStakeEnduringDelegator
+            { paseDelegatorPendingChange = NoChange,
+              ..
+            }
 
 -- | This relies on the fact that the 'AccountV2' hashing of 'AccountStake' is independent of the
 --  staked amount.
@@ -1494,22 +1509,31 @@ migrateEnduringDataV2 ed = do
 -- | Migrate enduring data from 'AccountV2' to 'AccountV3'. If there was a stake cooldown in effect,
 --  that is migrated to a pre-pre-cooldown in the new state.
 migrateEnduringDataV2toV3 ::
-    (SupportMigration m t) =>
+    (SupportMigration m t, AccountMigration 'AccountV3 (t m)) =>
+    -- | Current enduring data
     PersistentAccountEnduringData 'AccountV2 ->
-    AccountMigrationStateTT oldpv pv t m (PersistentAccountEnduringData 'AccountV3)
+    -- | New amount and enduring data.
+    State.StateT Amount (t m) (PersistentAccountEnduringData 'AccountV3)
 migrateEnduringDataV2toV3 ed = do
     paedPersistingData <- migrateEagerBufferedRef return (paedPersistingData ed)
     paedEncryptedAmount <- forM (paedEncryptedAmount ed) $ migrateReference migratePersistentEncryptedAmount
     paedReleaseSchedule <- forM (paedReleaseSchedule ed) $ \(oldRSRef, lockedAmt) -> do
         newRSRef <- migrateReference migrateAccountReleaseSchedule oldRSRef
         return (newRSRef, lockedAmt)
-    (paedStake, oldPendingChange) <- migratePersistentAccountStakeEnduringV2toV3 (paedStake ed)
-    -- On migration, anything that is currently in cooldown we move to pre-pre-cooldown.
-    paedStakeCooldown <- case oldPendingChange of
-        NoChange -> return emptyCooldownQueue
-        ReduceStake target _ -> addAccountInPrePreCooldown >> initialPrePreCooldownQueue target
-        RemoveStake _ -> addAccountInPrePreCooldown >> initialPrePreCooldownQueue 0
-    makeAccountEnduringDataAV3 paedPersistingData paedEncryptedAmount paedReleaseSchedule paedStake paedStakeCooldown
+    (paedStake, newTargetStake) <- migratePersistentAccountStakeEnduringV2toV3 (paedStake ed)
+    paedStakeCooldown <- case newTargetStake of
+        Nothing -> return emptyCooldownQueue
+        Just targetAmount -> do
+            lift addAccountInPrePreCooldown
+            stakeAmount <- State.get
+            State.put targetAmount
+            initialPrePreCooldownQueue (stakeAmount - targetAmount)
+    makeAccountEnduringDataAV3
+        paedPersistingData
+        paedEncryptedAmount
+        paedReleaseSchedule
+        paedStake
+        paedStakeCooldown
 
 -- | Migration for 'PersistentAccountEnduringData'. Only supports 'AccountV3'.
 --  The data is unchanged in the migration.
@@ -1552,20 +1576,21 @@ migrateV2ToV2 acc = do
 migrateV2ToV3 ::
     ( MonadBlobStore m,
       MonadBlobStore (t m),
+      AccountMigration 'AccountV3 (t m),
       MonadTrans t
     ) =>
     PersistentAccount 'AccountV2 ->
-    AccountMigrationStateTT oldpv pv t m (PersistentAccount 'AccountV3)
+    t m (PersistentAccount 'AccountV3)
 migrateV2ToV3 acc = do
-    accountEnduringData <-
-        migrateEagerBufferedRef
-            migrateEnduringDataV2toV3
-            (accountEnduringData acc)
+    (accountEnduringData, newStakedAmount) <-
+        State.runStateT
+            (migrateEagerBufferedRef migrateEnduringDataV2toV3 (accountEnduringData acc))
+            (accountStakedAmount acc)
     return $!
         PersistentAccount
             { accountNonce = accountNonce acc,
               accountAmount = accountAmount acc,
-              accountStakedAmount = accountStakedAmount acc,
+              accountStakedAmount = newStakedAmount, -- FIXME!
               ..
             }
 
@@ -1593,11 +1618,12 @@ migratePersistentAccount ::
     forall m t oldpv pv.
     ( IsProtocolVersion oldpv,
       SupportMigration m t,
+      AccountMigration (AccountVersionFor pv) (t m),
       AccountStructureVersionFor (AccountVersionFor oldpv) ~ 'AccountStructureV1
     ) =>
     StateMigrationParameters oldpv pv ->
     PersistentAccount (AccountVersionFor oldpv) ->
-    AccountMigrationStateTT oldpv pv t m (PersistentAccount (AccountVersionFor pv))
+    t m (PersistentAccount (AccountVersionFor pv))
 migratePersistentAccount StateMigrationParametersTrivial acc = case accountVersion @(AccountVersionFor oldpv) of
     SAccountV2 -> migrateV2ToV2 acc
     SAccountV3 -> migrateV3ToV3 acc
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs
index 753db8b38..9e644e161 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs
@@ -68,6 +68,8 @@ import Concordium.GlobalState.BlockState (AccountsHash (..))
 import Concordium.GlobalState.Parameters
 import Concordium.GlobalState.Persistent.Account
 import Concordium.GlobalState.Persistent.Account.MigrationState
+import Concordium.GlobalState.Persistent.Account.MigrationStateInterface
+import Concordium.GlobalState.Persistent.Bakers
 import Concordium.GlobalState.Persistent.BlobStore
 import Concordium.GlobalState.Persistent.Cache
 import Concordium.GlobalState.Persistent.CachedRef
@@ -76,16 +78,19 @@ import qualified Concordium.GlobalState.Persistent.LFMBTree as L
 import qualified Concordium.GlobalState.Persistent.Trie as Trie
 import qualified Concordium.ID.Types as ID
 import Concordium.Types
+import Concordium.Types.Accounts
 import Concordium.Types.HashableTo
 import Concordium.Types.Option (Option (..))
 import Concordium.Utils
 import Control.Monad
 import Control.Monad.Reader
+import Data.Bool.Singletons
 import Data.Foldable (foldlM)
 import Data.IORef
 import qualified Data.Map.Strict as Map
 import Data.Maybe
 import Data.Serialize
+import Lens.Micro.Platform
 
 -- | Representation of the set of accounts on the chain.
 --  Each account has an 'AccountIndex' which is the order
@@ -313,7 +318,7 @@ getAccountByCredId cid accs@Accounts{..} =
 --  First try lookup in the in-memory difference map associated with the the provided 'Accounts pv',
 --  if no account could be looked up, then we fall back to the lmdb backed account map.
 --
--- If account alises are supported then the equivalence class 'AccountAddressEq' is used for determining
+-- If account aliases are supported then the equivalence class 'AccountAddressEq' is used for determining
 -- whether the provided @AccountAddress@ is in the map, otherwise we check for exactness.
 getAccountIndex :: forall pv m. (SupportsPersistentAccount pv m) => AccountAddress -> Accounts pv -> m (Maybe AccountIndex)
 getAccountIndex addr Accounts{..} = do
@@ -485,6 +490,53 @@ tryPopulateLMDBStore accts = do
                 ([], 0)
                 accts
 
+-- | Construct an initial 'PersistentActiveBakers' that records all of the bakers that are still
+-- active after migration, but does not include any delegators. This only applies when migrating
+-- to a protocol version from P7 onwards.
+--
+-- The idea is that with the P6->P7 migration, bakers that are in cooldown to be removed will
+-- actually be removed as bakers.
+initialPersistentActiveBakersForMigration ::
+    forall oldpv av t m.
+    ( IsProtocolVersion oldpv,
+      IsAccountVersion av,
+      SupportMigration m t,
+      SupportsPersistentAccount oldpv m
+    ) =>
+    Accounts oldpv ->
+    PersistentActiveBakers (AccountVersionFor oldpv) ->
+    t m (Conditionally (SupportsFlexibleCooldown av) (PersistentActiveBakers av))
+initialPersistentActiveBakersForMigration oldAccounts oldActiveBakers = case sSupportsFlexibleCooldown (accountVersion @av) of
+    SFalse -> return CFalse
+    STrue -> do
+        bakers <- lift $ Trie.keysAsc (oldActiveBakers ^. activeBakers)
+        CTrue <$> foldM accumBakers emptyPersistentActiveBakers bakers
+      where
+        accumBakers :: PersistentActiveBakers av -> BakerId -> t m (PersistentActiveBakers av)
+        accumBakers pab bakerId =
+            lift (indexedAccount (bakerAccountIndex bakerId) oldAccounts) >>= \case
+                Nothing -> error "Baker account does not exist"
+                Just account -> do
+                    lift (accountBaker account) >>= \case
+                        Nothing -> error "Baker account is not a baker."
+                        Just bkr
+                            | RemoveStake{} <- _bakerPendingChange bkr -> do
+                                -- The baker is pending removal, so it will be removed from
+                                -- the account in this update.
+                                return pab
+                            | otherwise -> do
+                                -- The baker is still active, so add it to the persistent active
+                                -- bakers.
+                                newActiveBakers <- Trie.insert bakerId emptyPersistentActiveDelegators (pab ^. activeBakers)
+                                newAggregationKeys <- Trie.insert (bkr ^. bakerAggregationVerifyKey) () (pab ^. aggregationKeys)
+                                let newTotalActiveCapital = addActiveCapital (bkr ^. stakedAmount) (pab ^. totalActiveCapital)
+                                return
+                                    pab
+                                        { _activeBakers = newActiveBakers,
+                                          _aggregationKeys = newAggregationKeys,
+                                          _totalActiveCapital = newTotalActiveCapital
+                                        }
+
 -- | See documentation of @migratePersistentBlockState@.
 migrateAccounts ::
     forall oldpv pv t m.
@@ -495,9 +547,11 @@ migrateAccounts ::
       SupportsPersistentAccount pv (t m)
     ) =>
     StateMigrationParameters oldpv pv ->
+    PersistentActiveBakers (AccountVersionFor oldpv) ->
     Accounts oldpv ->
     t m (Accounts pv, AccountMigrationState oldpv pv)
-migrateAccounts migration Accounts{..} = do
+migrateAccounts migration pab accts@Accounts{..} = do
+    initialPAB' <- initialPersistentActiveBakersForMigration accts pab
     let migrateAccount acct = do
             newAcct <- migrateHashedCachedRef' (migratePersistentAccount migration) acct
             -- Increment the account index counter.
@@ -509,7 +563,7 @@ migrateAccounts migration Accounts{..} = do
                 migrateAccount
                 accountTable
             )
-            initialAccountMigrationState
+            (initialAccountMigrationState initialPAB')
     -- The account registration IDs are not cached. There is a separate cache
     -- that is purely in-memory and just copied over.
     newAccountRegIds <- Trie.migrateUnbufferedTrieN return accountRegIdHistory
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Bakers.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Bakers.hs
index 593790c9c..f1e9ce40f 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Bakers.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Bakers.hs
@@ -27,7 +27,6 @@ import qualified Concordium.Genesis.Data.P6 as P6
 import Concordium.GlobalState.BakerInfo
 import Concordium.GlobalState.Parameters
 import Concordium.GlobalState.Persistent.Account
-import qualified Concordium.GlobalState.Persistent.Accounts as Accounts
 import Concordium.GlobalState.Persistent.BlobStore
 import Concordium.Types
 import qualified Concordium.Types.Accounts as BaseAccounts
@@ -383,53 +382,38 @@ tacAmount f (TotalActiveCapitalV1 amt) = TotalActiveCapitalV1 <$> f amt
 
 type AggregationKeySet = Trie.TrieN BufferedFix BakerAggregationVerifyKey ()
 
+-- | Persistent representation of the state of the active bakers and delegators.
 data PersistentActiveBakers (av :: AccountVersion) = PersistentActiveBakers
-    { _activeBakers :: !(BakerIdTrieMap av),
+    { -- | For each active baker, this records the set of delegators and their total stake.
+      --  (This does not include the baker's own stake.)
+      _activeBakers :: !(BakerIdTrieMap av),
+      -- | The set of aggregation keys of all active bakers.
+      -- This is used to prevent duplicate aggregation keys from being deployed.
       _aggregationKeys :: !AggregationKeySet,
+      -- | The set of delegators to the passive pool, with their total stake.
       _passiveDelegators :: !(PersistentActiveDelegators av),
+      -- | The total capital staked by all bakers and delegators.
       _totalActiveCapital :: !(TotalActiveCapital av)
     }
     deriving (Show)
 
 makeLenses ''PersistentActiveBakers
 
--- | See documentation of @migratePersistentBlockState@.
-migratePersistentActiveBakers ::
-    forall oldpv pv t m.
-    ( IsProtocolVersion oldpv,
-      IsProtocolVersion pv,
-      SupportMigration m t,
-      Accounts.SupportsPersistentAccount pv (t m)
-    ) =>
-    StateMigrationParameters oldpv pv ->
-    -- | Already migrated accounts.
-    Accounts.Accounts pv ->
-    PersistentActiveBakers (AccountVersionFor oldpv) ->
-    t m (PersistentActiveBakers (AccountVersionFor pv))
-migratePersistentActiveBakers migration accounts PersistentActiveBakers{..} = do
-    newActiveBakers <- Trie.migrateTrieN True (migratePersistentActiveDelegators migration) _activeBakers
-    newAggregationKeys <- Trie.migrateTrieN True return _aggregationKeys
-    newPassiveDelegators <- migratePersistentActiveDelegators migration _passiveDelegators
-    bakerIds <- Trie.keysAsc newActiveBakers
-    totalStakedAmount <-
-        foldM
-            ( \acc (BakerId aid) ->
-                Accounts.indexedAccount aid accounts >>= \case
-                    Nothing -> error "Baker account does not exist."
-                    Just pa ->
-                        accountBakerStakeAmount pa >>= \case
-                            Nothing -> error "Baker account not a baker."
-                            Just amt -> return $! (acc + amt)
-            )
-            0
-            bakerIds
-    let newTotalActiveCapital = migrateTotalActiveCapital migration totalStakedAmount _totalActiveCapital
-    return
+emptyPersistentActiveBakers :: forall av. (IsAccountVersion av) => PersistentActiveBakers av
+emptyPersistentActiveBakers = case delegationSupport @av of
+    SAVDelegationSupported ->
+        PersistentActiveBakers
+            { _activeBakers = Trie.empty,
+              _aggregationKeys = Trie.empty,
+              _passiveDelegators = PersistentActiveDelegatorsV1 Trie.empty 0,
+              _totalActiveCapital = TotalActiveCapitalV1 0
+            }
+    SAVDelegationNotSupported ->
         PersistentActiveBakers
-            { _activeBakers = newActiveBakers,
-              _aggregationKeys = newAggregationKeys,
-              _passiveDelegators = newPassiveDelegators,
-              _totalActiveCapital = newTotalActiveCapital
+            { _activeBakers = Trie.empty,
+              _aggregationKeys = Trie.empty,
+              _passiveDelegators = PersistentActiveDelegatorsV0,
+              _totalActiveCapital = TotalActiveCapitalV0
             }
 
 totalActiveCapitalV1 :: (AVSupportsDelegation av) => Lens' (PersistentActiveBakers av) Amount
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
index 88fac15f4..cfdabf34c 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
@@ -188,6 +188,45 @@ migrateSeedStateV1Trivial SeedStateV1{..} =
     -- at the trigger block from the previous consensus.
     newNonce = H.hash $ "Regenesis" <> encode ss1UpdatedNonce
 
+-- | See documentation of @migratePersistentBlockState@.
+migratePersistentActiveBakers ::
+    forall oldpv pv t m.
+    ( IsProtocolVersion oldpv,
+      IsProtocolVersion pv,
+      SupportMigration m t,
+      SupportsPersistentAccount pv (t m)
+    ) =>
+    StateMigrationParameters oldpv pv ->
+    -- | Already migrated accounts.
+    Accounts.Accounts pv ->
+    PersistentActiveBakers (AccountVersionFor oldpv) ->
+    t m (PersistentActiveBakers (AccountVersionFor pv))
+migratePersistentActiveBakers migration accounts PersistentActiveBakers{..} = do
+    newActiveBakers <- Trie.migrateTrieN True (migratePersistentActiveDelegators migration) _activeBakers
+    newAggregationKeys <- Trie.migrateTrieN True return _aggregationKeys
+    newPassiveDelegators <- migratePersistentActiveDelegators migration _passiveDelegators
+    bakerIds <- Trie.keysAsc newActiveBakers
+    totalStakedAmount <-
+        foldM
+            ( \acc (BakerId aid) ->
+                Accounts.indexedAccount aid accounts >>= \case
+                    Nothing -> error "Baker account does not exist."
+                    Just pa ->
+                        accountBakerStakeAmount pa >>= \case
+                            Nothing -> error "Baker account not a baker."
+                            Just amt -> return $! (acc + amt)
+            )
+            0
+            bakerIds
+    let newTotalActiveCapital = migrateTotalActiveCapital migration totalStakedAmount _totalActiveCapital
+    return
+        PersistentActiveBakers
+            { _activeBakers = newActiveBakers,
+              _aggregationKeys = newAggregationKeys,
+              _passiveDelegators = newPassiveDelegators,
+              _totalActiveCapital = newTotalActiveCapital
+            }
+
 -- | See documentation of @migratePersistentBlockState@.
 --
 --  Migrate the birk parameters assuming accounts have already been migrated.
@@ -1476,6 +1515,7 @@ doConfigureBaker ::
     BakerConfigure ->
     m (BakerConfigureResult, PersistentBlockState pv)
 doConfigureBaker pbs ai BakerConfigureAdd{..} = do
+    -- FIXME: Support using stake that is in cooldown.
     -- It is assumed here that this account is NOT a baker and NOT a delegator.
     bsp <- loadPBS pbs
     Accounts.indexedAccount ai (bspAccounts bsp) >>= \case
@@ -1714,7 +1754,8 @@ doConfigureBaker pbs ai BakerConfigureUpdate{..} = do
                         MTL.modify' $ \bsp -> bsp{bspBirkParameters = birkParams & birkActiveBakers .~ newActiveBkrs}
                         MTL.tell [BakerConfigureStakeIncreased capital]
                         return $ setAccountStake capital
-    updateCapital STrue _ _ = undefined
+    updateCapital STrue oldBkr cp = ifPresent bcuCapital $ \capital -> do
+        undefined
 
 doConstrainBakerCommission ::
     (SupportsPersistentState pv m, PVSupportsDelegation pv) =>
@@ -3747,7 +3788,8 @@ migrateBlockPointers migration BlockStatePointers{..} = do
             StateMigrationParametersP5ToP6{} -> RSMNewToNew
             StateMigrationParametersP6ToP7{} -> RSMNewToNew
     newReleaseSchedule <- migrateReleaseSchedule rsMigration bspReleaseSchedule
-    (newAccounts, migrationState) <- Accounts.migrateAccounts migration bspAccounts
+    pab <- refLoad $ bspBirkParameters ^. birkActiveBakers
+    (newAccounts, migrationState) <- Accounts.migrateAccounts migration pab bspAccounts
     newAccountsInCooldown <-
         migrateAccountsInCooldownForPV
             (MigrationState._migrationPrePreCooldown migrationState)
@@ -3876,7 +3918,8 @@ cacheStateAndGetTransactionTable hpbs = do
                 then
                     return $!
                         tt
-                            & TransactionTable.ttNonFinalizedChainUpdates . at' uty
+                            & TransactionTable.ttNonFinalizedChainUpdates
+                                . at' uty
                                 ?~ TransactionTable.emptyNFCUWithSequenceNumber sn
                 else return tt
     tt <- foldM updInTT TransactionTable.emptyTransactionTable [minBound ..]
diff --git a/concordium-consensus/src/Concordium/Scheduler.hs b/concordium-consensus/src/Concordium/Scheduler.hs
index 83549979d..19e47c6ab 100644
--- a/concordium-consensus/src/Concordium/Scheduler.hs
+++ b/concordium-consensus/src/Concordium/Scheduler.hs
@@ -2105,6 +2105,7 @@ handleConfigureBaker
             accountStake <- getAccountStake (snd senderAccount)
             arg <- case accountStake of
                 AccountStakeNone -> configureAddBakerArg
+                -- FIXME: in new consensus, allow direct switch between baker and delegator.
                 AccountStakeDelegate _ -> rejectTransaction AlreadyADelegator
                 AccountStakeBaker _ ->
                     configureUpdateBakerArg

From c3c8b0120a1d1c450e0e24c9105ba578fb30885c Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Mon, 6 May 2024 16:41:01 +0200
Subject: [PATCH 09/81] Migrate cooldowns on accounts.

---
 .../Persistent/Account/MigrationState.hs      | 100 +++++++++++++++--
 .../Account/MigrationStateInterface.hs        |   6 +-
 .../Persistent/Account/StructureV1.hs         | 103 ++++++++++++------
 .../GlobalState/Persistent/Accounts.hs        |  79 ++------------
 .../GlobalState/Persistent/BlockState.hs      |   8 +-
 5 files changed, 183 insertions(+), 113 deletions(-)

diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationState.hs
index b4fe1ca76..ec8f55284 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationState.hs
@@ -9,6 +9,7 @@
 
 module Concordium.GlobalState.Persistent.Account.MigrationState where
 
+import Control.Monad
 import Control.Monad.IO.Class
 import Control.Monad.State.Class
 import Control.Monad.Trans
@@ -19,10 +20,14 @@ import Data.Maybe
 import Lens.Micro.Platform
 
 import Concordium.Types
+import Concordium.Types.Accounts
 import Concordium.Types.Conditionally
 import Concordium.Utils
 
+import qualified Concordium.GlobalState.AccountMap.LMDB as LMDBAccountMap
+import Concordium.GlobalState.Persistent.Account
 import Concordium.GlobalState.Persistent.Account.MigrationStateInterface
+import Concordium.GlobalState.Persistent.Accounts
 import Concordium.GlobalState.Persistent.Bakers as Bakers
 import Concordium.GlobalState.Persistent.BlobStore
 import Concordium.GlobalState.Persistent.Cache
@@ -52,6 +57,52 @@ data AccountMigrationState (oldpv :: ProtocolVersion) (pv :: ProtocolVersion) =
     }
 makeLenses ''AccountMigrationState
 
+-- | Construct an initial 'PersistentActiveBakers' that records all of the bakers that are still
+-- active after migration, but does not include any delegators. This only applies when migrating
+-- to a protocol version from P7 onwards.
+--
+-- The idea is that with the P6->P7 migration, bakers that are in cooldown to be removed will
+-- actually be removed as bakers.
+initialPersistentActiveBakersForMigration ::
+    forall oldpv av t m.
+    ( IsAccountVersion av,
+      SupportMigration m t,
+      SupportsPersistentAccount oldpv m
+    ) =>
+    Accounts oldpv ->
+    PersistentActiveBakers (AccountVersionFor oldpv) ->
+    t m (Conditionally (SupportsFlexibleCooldown av) (PersistentActiveBakers av))
+initialPersistentActiveBakersForMigration oldAccounts oldActiveBakers = case sSupportsFlexibleCooldown (accountVersion @av) of
+    SFalse -> return CFalse
+    STrue -> do
+        bakers <- lift $ Trie.keysAsc (oldActiveBakers ^. activeBakers)
+        CTrue <$> foldM accumBakers emptyPersistentActiveBakers bakers
+      where
+        accumBakers :: PersistentActiveBakers av -> BakerId -> t m (PersistentActiveBakers av)
+        accumBakers pab bakerId =
+            lift (indexedAccount (bakerAccountIndex bakerId) oldAccounts) >>= \case
+                Nothing -> error "Baker account does not exist"
+                Just account -> do
+                    lift (accountBaker account) >>= \case
+                        Nothing -> error "Baker account is not a baker."
+                        Just bkr
+                            | RemoveStake{} <- _bakerPendingChange bkr -> do
+                                -- The baker is pending removal, so it will be removed from
+                                -- the account in this update.
+                                return pab
+                            | otherwise -> do
+                                -- The baker is still active, so add it to the persistent active
+                                -- bakers.
+                                newActiveBakers <- Trie.insert bakerId emptyPersistentActiveDelegators (pab ^. activeBakers)
+                                newAggregationKeys <- Trie.insert (bkr ^. bakerAggregationVerifyKey) () (pab ^. aggregationKeys)
+                                let newTotalActiveCapital = addActiveCapital (bkr ^. stakedAmount) (pab ^. totalActiveCapital)
+                                return
+                                    pab
+                                        { _activeBakers = newActiveBakers,
+                                          _aggregationKeys = newAggregationKeys,
+                                          _totalActiveCapital = newTotalActiveCapital
+                                        }
+
 -- | An 'AccountMigrationState' in an initial state.
 initialAccountMigrationState ::
     forall oldpv pv.
@@ -61,7 +112,7 @@ initialAccountMigrationState ::
         (SupportsFlexibleCooldown (AccountVersionFor pv))
         (PersistentActiveBakers (AccountVersionFor pv)) ->
     AccountMigrationState oldpv pv
-initialAccountMigrationState _removedBakers = AccountMigrationState{..}
+initialAccountMigrationState _persistentActiveBakers = AccountMigrationState{..}
   where
     _migrationPrePreCooldown = case sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor oldpv)) of
         SFalse -> case sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv)) of
@@ -69,11 +120,21 @@ initialAccountMigrationState _removedBakers = AccountMigrationState{..}
             STrue -> CTrue Null
         STrue -> CFalse
     _currentAccountIndex = 0
-    _persistentActiveBakers =
-        conditionally
-            (sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv)))
-            emptyPersistentActiveBakers
 
+-- | Construct an initial account migration state that
+makeInitialAccountMigrationState ::
+    ( IsProtocolVersion pv,
+      SupportMigration m t,
+      SupportsPersistentAccount oldpv m
+    ) =>
+    Accounts oldpv ->
+    PersistentActiveBakers (AccountVersionFor oldpv) ->
+    t m (AccountMigrationState oldpv pv)
+makeInitialAccountMigrationState accounts pab =
+    initialAccountMigrationState <$> initialPersistentActiveBakersForMigration accounts pab
+
+-- | A monad transformer transformer that left-composes @StateT (AccountMigrationState old pv)@
+--  with a given monad transformer @t@.
 newtype
     AccountMigrationStateTT
         (oldpv :: ProtocolVersion)
@@ -84,9 +145,19 @@ newtype
     { runAccountMigrationStateTT' ::
         StateT (AccountMigrationState oldpv pv) (t m) a
     }
-    deriving newtype (Functor, Applicative, Monad, MonadState (AccountMigrationState oldpv pv), MonadIO)
+    deriving newtype
+        ( Functor,
+          Applicative,
+          Monad,
+          MonadState (AccountMigrationState oldpv pv),
+          MonadIO,
+          LMDBAccountMap.MonadAccountMapStore
+        )
 
-runAccountMigrationStateTT :: AccountMigrationStateTT oldpv pv t m a -> AccountMigrationState oldpv pv -> t m (a, AccountMigrationState oldpv pv)
+runAccountMigrationStateTT ::
+    AccountMigrationStateTT oldpv pv t m a ->
+    AccountMigrationState oldpv pv ->
+    t m (a, AccountMigrationState oldpv pv)
 runAccountMigrationStateTT = runStateT . runAccountMigrationStateTT'
 
 deriving via
@@ -142,5 +213,16 @@ instance
             CTrue pab ->
                 isNothing <$> Trie.lookup bakerId (pab ^. activeBakers)
 
-    addDelegator delId delAmt delTarget = do
-        undefined
+    retainDelegator delId delAmt delTarget =
+        use persistentActiveBakers >>= \case
+            CTrue pab ->
+                Bakers.addDelegator delTarget delId delAmt pab >>= \case
+                    Left bid ->
+                        error $
+                            "Baker "
+                                ++ show bid
+                                ++ " (delegated to by "
+                                ++ show delId
+                                ++ ") is not a baker."
+                    Right newPAB -> persistentActiveBakers .= CTrue newPAB
+            CFalse -> return ()
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationStateInterface.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationStateInterface.hs
index 4b6cbeaa7..6e0e23a20 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationStateInterface.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationStateInterface.hs
@@ -16,6 +16,6 @@ class AccountMigration (av :: AccountVersion) m | m -> av where
     --  (The result is unspecified if the 'BakerId' was not a baker prior to migration.)
     isBakerRemoved :: BakerId -> m Bool
 
-    -- | Add a delegator, delegating a specified amount to a delegation target.
-    --  The delegator must not already have been added.
-    addDelegator :: (AVSupportsDelegation av) => DelegatorId -> Amount -> DelegationTarget -> m ()
+    -- | Record that a delegator is retained, delegating a specified amount to a delegation target.
+    --  The delegator must not already have been retained.
+    retainDelegator :: (AVSupportsDelegation av) => DelegatorId -> Amount -> DelegationTarget -> m ()
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
index c898265d0..f74e51779 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
@@ -205,23 +205,41 @@ migratePersistentAccountStakeEnduring PersistentAccountStakeEnduringDelegator{..
     return $! PersistentAccountStakeEnduringDelegator{..}
 
 -- | Migrate a 'PersistentAccountStakeEnduring' from 'AccountV2' to 'AccountV3'.
---  If a cooldown is in effect on the account, then the pending change is removed and returned.
---  The idea is that the target stake will become the pre-pre-cooldown target on migration.
+--  If a cooldown is in effect on the account, then the pending change is removed and the amount
+--  of stake entering cooldown is returned.
+--  If the account is a delegator, then this checks if it was delegating to a baker
+--  that has been removed as a result of the migration, and if so, delegates to passive instead.
+--  Either way, 'retainDelegator' is called with the delegator ID and updated delegated amount and
+--  target.
+--  If the account is not in cooldown, 'Nothing' is returned.
+-- The 'Amount' in the 'State.StateT' represents the current active stake on the account.
 migratePersistentAccountStakeEnduringV2toV3 ::
-    (SupportMigration m t) =>
+    (SupportMigration m t, AccountMigration 'AccountV3 (t m)) =>
     PersistentAccountStakeEnduring 'AccountV2 ->
-    -- | Returns the new 'PersistentAccountStakeEnduring' and the new stake if it changes as a
-    -- result of entering cooldown.
-    t m (PersistentAccountStakeEnduring 'AccountV3, Maybe Amount)
+    -- | Returns the new 'PersistentAccountStakeEnduring' and the amount entering cooldown (if any).
+    State.StateT Amount (t m) (PersistentAccountStakeEnduring 'AccountV3, CooldownQueue 'AccountV3)
 migratePersistentAccountStakeEnduringV2toV3 PersistentAccountStakeEnduringNone =
-    return (PersistentAccountStakeEnduringNone, Nothing)
+    return (PersistentAccountStakeEnduringNone, emptyCooldownQueue)
 migratePersistentAccountStakeEnduringV2toV3 PersistentAccountStakeEnduringBaker{..} =
     case paseBakerPendingChange of
         RemoveStake _ -> do
             -- The baker is being removed, so we don't migrate it.
-            return (PersistentAccountStakeEnduringNone, Just 0)
-        ReduceStake amt _ -> (,Just amt) <$> keepBakerInfo
-        NoChange -> (,Nothing) <$> keepBakerInfo
+            cooldownAmount <- id <<.= 0 -- Get the old stake, updating it to 0.
+            cooldown <- initialPrePreCooldownQueue cooldownAmount
+            return (PersistentAccountStakeEnduringNone, cooldown)
+        ReduceStake newStake _ -> do
+            oldStake <- State.get
+            unless (newStake <= oldStake) $
+                error $
+                    "Stake on baker 'reduced' from "
+                        ++ show oldStake
+                        ++ " to "
+                        ++ show newStake
+            State.put newStake
+            cooldown <- initialPrePreCooldownQueue (oldStake - newStake)
+            newPASE <- keepBakerInfo
+            return (newPASE, cooldown)
+        NoChange -> (,emptyCooldownQueue) <$> keepBakerInfo
   where
     keepBakerInfo = do
         newBakerInfo <- migrateReference (return . coerceBakerInfoExV1) paseBakerInfo
@@ -233,15 +251,40 @@ migratePersistentAccountStakeEnduringV2toV3 PersistentAccountStakeEnduringBaker{
                 }
 migratePersistentAccountStakeEnduringV2toV3 PersistentAccountStakeEnduringDelegator{..} =
     case paseDelegatorPendingChange of
-        RemoveStake _ -> return (PersistentAccountStakeEnduringNone, Just 0)
-        ReduceStake amt _ -> return $!! (newDelegatorInfo, Just amt)
-        NoChange -> return $!! (newDelegatorInfo, Nothing)
-  where
-    newDelegatorInfo =
-        PersistentAccountStakeEnduringDelegator
-            { paseDelegatorPendingChange = NoChange,
-              ..
-            }
+        RemoveStake _ -> do
+            cooldownAmount <- id <<.= 0 -- Get the old stake, updating it to 0.
+            cooldown <- initialPrePreCooldownQueue cooldownAmount
+            return (PersistentAccountStakeEnduringNone, cooldown)
+        _ -> do
+            newTarget <- case paseDelegatorTarget of
+                DelegatePassive -> return DelegatePassive
+                DelegateToBaker bid -> do
+                    removed <- lift $ isBakerRemoved bid
+                    return $ if removed then DelegatePassive else paseDelegatorTarget
+            let newDelegatorInfo =
+                    PersistentAccountStakeEnduringDelegator
+                        { paseDelegatorPendingChange = NoChange,
+                          paseDelegatorTarget = newTarget,
+                          ..
+                        }
+            oldStake <- State.get
+            case paseDelegatorPendingChange of
+                ReduceStake newStake _ -> do
+                    unless (newStake <= oldStake) $
+                        error $
+                            "Stake on delegator "
+                                ++ show paseDelegatorId
+                                ++ " 'reduced' from "
+                                ++ show oldStake
+                                ++ " to "
+                                ++ show newStake
+                    State.put newStake
+                    cooldown <- initialPrePreCooldownQueue (oldStake - newStake)
+                    lift $ retainDelegator paseDelegatorId newStake newTarget
+                    return $!! (newDelegatorInfo, cooldown)
+                NoChange -> do
+                    lift $ retainDelegator paseDelegatorId oldStake newTarget
+                    return $!! (newDelegatorInfo, emptyCooldownQueue)
 
 -- | This relies on the fact that the 'AccountV2' hashing of 'AccountStake' is independent of the
 --  staked amount.
@@ -605,6 +648,7 @@ instance (MonadBlobStore m, IsAccountVersion av) => BlobStorable m (PersistentAc
         (pea, newEncryptedAmount) <- storeUpdate paedEncryptedAmount
         (prs, newReleaseSchedule) <- storeUpdate paedReleaseSchedule
         (ps, newStake) <- suStake paedStake
+        (psc, newStakeCooldown) <- storeUpdate paedStakeCooldown
         let p = do
                 put paedHash
                 put flags
@@ -612,12 +656,14 @@ instance (MonadBlobStore m, IsAccountVersion av) => BlobStorable m (PersistentAc
                 when (edHasEncryptedAmount flags) pea
                 when (edHasReleaseSchedule flags) prs
                 ps
+                psc
             newpaed =
                 paed
                     { paedPersistingData = newPersistingData,
                       paedEncryptedAmount = newEncryptedAmount,
                       paedReleaseSchedule = newReleaseSchedule,
-                      paedStake = newStake
+                      paedStake = newStake,
+                      paedStakeCooldown = newStakeCooldown
                     }
         return $!! (p, newpaed)
       where
@@ -664,12 +710,13 @@ instance (MonadBlobStore m, IsAccountVersion av) => BlobStorable m (PersistentAc
                 paseDelegatorTarget <- if sfPassive then return DelegatePassive else DelegateToBaker <$> get
                 paseDelegatorPendingChange <- getPC sfChangeType
                 return . return $! PersistentAccountStakeEnduringDelegator{..}
+        mStakeCooldown <- load
         return $! do
             paedPersistingData <- mPersistingData
             paedEncryptedAmount <- mEncryptedAmount
             paedReleaseSchedule <- mReleaseSchedule
             paedStake <- mStake
-            let paedStakeCooldown = undefined
+            paedStakeCooldown <- mStakeCooldown
             return PersistentAccountEnduringData{..}
 
 -- * Persistent account
@@ -1507,12 +1554,13 @@ migrateEnduringDataV2 ed = do
             }
 
 -- | Migrate enduring data from 'AccountV2' to 'AccountV3'. If there was a stake cooldown in effect,
---  that is migrated to a pre-pre-cooldown in the new state.
+--  that is migrated to a pre-pre-cooldown in the new state. The 'Amount' in the 'State.StateT'
+--  represents the current active stake on the account.
 migrateEnduringDataV2toV3 ::
     (SupportMigration m t, AccountMigration 'AccountV3 (t m)) =>
     -- | Current enduring data
     PersistentAccountEnduringData 'AccountV2 ->
-    -- | New amount and enduring data.
+    -- | New enduring data.
     State.StateT Amount (t m) (PersistentAccountEnduringData 'AccountV3)
 migrateEnduringDataV2toV3 ed = do
     paedPersistingData <- migrateEagerBufferedRef return (paedPersistingData ed)
@@ -1520,14 +1568,7 @@ migrateEnduringDataV2toV3 ed = do
     paedReleaseSchedule <- forM (paedReleaseSchedule ed) $ \(oldRSRef, lockedAmt) -> do
         newRSRef <- migrateReference migrateAccountReleaseSchedule oldRSRef
         return (newRSRef, lockedAmt)
-    (paedStake, newTargetStake) <- migratePersistentAccountStakeEnduringV2toV3 (paedStake ed)
-    paedStakeCooldown <- case newTargetStake of
-        Nothing -> return emptyCooldownQueue
-        Just targetAmount -> do
-            lift addAccountInPrePreCooldown
-            stakeAmount <- State.get
-            State.put targetAmount
-            initialPrePreCooldownQueue (stakeAmount - targetAmount)
+    (paedStake, paedStakeCooldown) <- migratePersistentAccountStakeEnduringV2toV3 (paedStake ed)
     makeAccountEnduringDataAV3
         paedPersistingData
         paedEncryptedAmount
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs
index 9e644e161..e5945eee4 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs
@@ -67,9 +67,7 @@ import qualified Concordium.GlobalState.AccountMap.LMDB as LMDBAccountMap
 import Concordium.GlobalState.BlockState (AccountsHash (..))
 import Concordium.GlobalState.Parameters
 import Concordium.GlobalState.Persistent.Account
-import Concordium.GlobalState.Persistent.Account.MigrationState
 import Concordium.GlobalState.Persistent.Account.MigrationStateInterface
-import Concordium.GlobalState.Persistent.Bakers
 import Concordium.GlobalState.Persistent.BlobStore
 import Concordium.GlobalState.Persistent.Cache
 import Concordium.GlobalState.Persistent.CachedRef
@@ -78,19 +76,15 @@ import qualified Concordium.GlobalState.Persistent.LFMBTree as L
 import qualified Concordium.GlobalState.Persistent.Trie as Trie
 import qualified Concordium.ID.Types as ID
 import Concordium.Types
-import Concordium.Types.Accounts
 import Concordium.Types.HashableTo
 import Concordium.Types.Option (Option (..))
-import Concordium.Utils
 import Control.Monad
 import Control.Monad.Reader
-import Data.Bool.Singletons
 import Data.Foldable (foldlM)
 import Data.IORef
 import qualified Data.Map.Strict as Map
 import Data.Maybe
 import Data.Serialize
-import Lens.Micro.Platform
 
 -- | Representation of the set of accounts on the chain.
 --  Each account has an 'AccountIndex' which is the order
@@ -490,53 +484,6 @@ tryPopulateLMDBStore accts = do
                 ([], 0)
                 accts
 
--- | Construct an initial 'PersistentActiveBakers' that records all of the bakers that are still
--- active after migration, but does not include any delegators. This only applies when migrating
--- to a protocol version from P7 onwards.
---
--- The idea is that with the P6->P7 migration, bakers that are in cooldown to be removed will
--- actually be removed as bakers.
-initialPersistentActiveBakersForMigration ::
-    forall oldpv av t m.
-    ( IsProtocolVersion oldpv,
-      IsAccountVersion av,
-      SupportMigration m t,
-      SupportsPersistentAccount oldpv m
-    ) =>
-    Accounts oldpv ->
-    PersistentActiveBakers (AccountVersionFor oldpv) ->
-    t m (Conditionally (SupportsFlexibleCooldown av) (PersistentActiveBakers av))
-initialPersistentActiveBakersForMigration oldAccounts oldActiveBakers = case sSupportsFlexibleCooldown (accountVersion @av) of
-    SFalse -> return CFalse
-    STrue -> do
-        bakers <- lift $ Trie.keysAsc (oldActiveBakers ^. activeBakers)
-        CTrue <$> foldM accumBakers emptyPersistentActiveBakers bakers
-      where
-        accumBakers :: PersistentActiveBakers av -> BakerId -> t m (PersistentActiveBakers av)
-        accumBakers pab bakerId =
-            lift (indexedAccount (bakerAccountIndex bakerId) oldAccounts) >>= \case
-                Nothing -> error "Baker account does not exist"
-                Just account -> do
-                    lift (accountBaker account) >>= \case
-                        Nothing -> error "Baker account is not a baker."
-                        Just bkr
-                            | RemoveStake{} <- _bakerPendingChange bkr -> do
-                                -- The baker is pending removal, so it will be removed from
-                                -- the account in this update.
-                                return pab
-                            | otherwise -> do
-                                -- The baker is still active, so add it to the persistent active
-                                -- bakers.
-                                newActiveBakers <- Trie.insert bakerId emptyPersistentActiveDelegators (pab ^. activeBakers)
-                                newAggregationKeys <- Trie.insert (bkr ^. bakerAggregationVerifyKey) () (pab ^. aggregationKeys)
-                                let newTotalActiveCapital = addActiveCapital (bkr ^. stakedAmount) (pab ^. totalActiveCapital)
-                                return
-                                    pab
-                                        { _activeBakers = newActiveBakers,
-                                          _aggregationKeys = newAggregationKeys,
-                                          _totalActiveCapital = newTotalActiveCapital
-                                        }
-
 -- | See documentation of @migratePersistentBlockState@.
 migrateAccounts ::
     forall oldpv pv t m.
@@ -544,34 +491,30 @@ migrateAccounts ::
       IsProtocolVersion pv,
       SupportMigration m t,
       SupportsPersistentAccount oldpv m,
-      SupportsPersistentAccount pv (t m)
+      SupportsPersistentAccount pv (t m),
+      AccountMigration (AccountVersionFor pv) (t m)
     ) =>
     StateMigrationParameters oldpv pv ->
-    PersistentActiveBakers (AccountVersionFor oldpv) ->
     Accounts oldpv ->
-    t m (Accounts pv, AccountMigrationState oldpv pv)
-migrateAccounts migration pab accts@Accounts{..} = do
-    initialPAB' <- initialPersistentActiveBakersForMigration accts pab
+    t m (Accounts pv)
+migrateAccounts migration Accounts{..} = do
     let migrateAccount acct = do
             newAcct <- migrateHashedCachedRef' (migratePersistentAccount migration) acct
             -- Increment the account index counter.
             nextAccount
             return newAcct
-    (newAccountTable, migrationState) <-
-        runAccountMigrationStateTT
-            ( L.migrateLFMBTree
-                migrateAccount
-                accountTable
-            )
-            (initialAccountMigrationState initialPAB')
+    newAccountTable <-
+        L.migrateLFMBTree
+            migrateAccount
+            accountTable
+
     -- The account registration IDs are not cached. There is a separate cache
     -- that is purely in-memory and just copied over.
     newAccountRegIds <- Trie.migrateUnbufferedTrieN return accountRegIdHistory
-    return $!!
+    return $!
         ( Accounts
             { accountTable = newAccountTable,
               accountRegIdHistory = newAccountRegIds,
               accountDiffMapRef = accountDiffMapRef
-            },
-          migrationState
+            }
         )
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
index cfdabf34c..e5d4a8701 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
@@ -3788,8 +3788,12 @@ migrateBlockPointers migration BlockStatePointers{..} = do
             StateMigrationParametersP5ToP6{} -> RSMNewToNew
             StateMigrationParametersP6ToP7{} -> RSMNewToNew
     newReleaseSchedule <- migrateReleaseSchedule rsMigration bspReleaseSchedule
-    pab <- refLoad $ bspBirkParameters ^. birkActiveBakers
-    (newAccounts, migrationState) <- Accounts.migrateAccounts migration pab bspAccounts
+    pab <- lift . refLoad $ bspBirkParameters ^. birkActiveBakers
+    initMigrationState :: MigrationState.AccountMigrationState oldpv pv <- MigrationState.makeInitialAccountMigrationState bspAccounts pab
+    (newAccounts, migrationState) <-
+        MigrationState.runAccountMigrationStateTT
+            (Accounts.migrateAccounts migration bspAccounts)
+            initMigrationState
     newAccountsInCooldown <-
         migrateAccountsInCooldownForPV
             (MigrationState._migrationPrePreCooldown migrationState)

From 1271bdfc7c00c6171b5f1313b8d1293a569b8613 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Mon, 6 May 2024 17:37:56 +0200
Subject: [PATCH 10/81] Make sure migrated active baker stake is computed
 correctly.

---
 .../Persistent/Account/MigrationState.hs      | 22 ++++++++++++++-----
 .../GlobalState/Persistent/BlockState.hs      | 19 +++++++++++-----
 2 files changed, 30 insertions(+), 11 deletions(-)

diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationState.hs
index ec8f55284..9ee0058c9 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationState.hs
@@ -59,7 +59,9 @@ makeLenses ''AccountMigrationState
 
 -- | Construct an initial 'PersistentActiveBakers' that records all of the bakers that are still
 -- active after migration, but does not include any delegators. This only applies when migrating
--- to a protocol version from P7 onwards.
+-- to a protocol version from P7 onwards. The total active capital constitutes the stake of all
+-- bakers that remain active, with their capital reduced corresponding to any pending reduction
+-- in their stakes.
 --
 -- The idea is that with the P6->P7 migration, bakers that are in cooldown to be removed will
 -- actually be removed as bakers.
@@ -85,17 +87,24 @@ initialPersistentActiveBakersForMigration oldAccounts oldActiveBakers = case sSu
                 Just account -> do
                     lift (accountBaker account) >>= \case
                         Nothing -> error "Baker account is not a baker."
-                        Just bkr
-                            | RemoveStake{} <- _bakerPendingChange bkr -> do
+                        Just bkr -> case _bakerPendingChange bkr of
+                            RemoveStake{} -> do
                                 -- The baker is pending removal, so it will be removed from
                                 -- the account in this update.
                                 return pab
-                            | otherwise -> do
+                            ReduceStake newStake _ -> do
+                                -- The baker's stake is reduced, so retain it with the new stake.
+                                retainBaker newStake
+                            NoChange -> do
+                                -- Retain the baker with the existing stake.
+                                retainBaker (bkr ^. stakedAmount)
+                          where
+                            retainBaker newStake = do
                                 -- The baker is still active, so add it to the persistent active
                                 -- bakers.
                                 newActiveBakers <- Trie.insert bakerId emptyPersistentActiveDelegators (pab ^. activeBakers)
                                 newAggregationKeys <- Trie.insert (bkr ^. bakerAggregationVerifyKey) () (pab ^. aggregationKeys)
-                                let newTotalActiveCapital = addActiveCapital (bkr ^. stakedAmount) (pab ^. totalActiveCapital)
+                                let newTotalActiveCapital = addActiveCapital newStake (pab ^. totalActiveCapital)
                                 return
                                     pab
                                         { _activeBakers = newActiveBakers,
@@ -121,7 +130,8 @@ initialAccountMigrationState _persistentActiveBakers = AccountMigrationState{..}
         STrue -> CFalse
     _currentAccountIndex = 0
 
--- | Construct an initial account migration state that
+-- | Construct an initial account migration state that records all of the active bakers that
+--  remain active after the migration. This is then used
 makeInitialAccountMigrationState ::
     ( IsProtocolVersion pv,
       SupportMigration m t,
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
index e5d4a8701..55db3001f 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
@@ -231,7 +231,7 @@ migratePersistentActiveBakers migration accounts PersistentActiveBakers{..} = do
 --
 --  Migrate the birk parameters assuming accounts have already been migrated.
 migratePersistentBirkParameters ::
-    forall oldpv pv t m.
+    forall c oldpv pv t m.
     ( IsProtocolVersion pv,
       IsProtocolVersion oldpv,
       SupportMigration m t,
@@ -239,10 +239,13 @@ migratePersistentBirkParameters ::
     ) =>
     StateMigrationParameters oldpv pv ->
     Accounts.Accounts pv ->
+    Conditionally c (PersistentActiveBakers (AccountVersionFor pv)) ->
     PersistentBirkParameters oldpv ->
     t m (PersistentBirkParameters pv)
-migratePersistentBirkParameters migration accounts PersistentBirkParameters{..} = do
-    newActiveBakers <- migrateReference (migratePersistentActiveBakers migration accounts) _birkActiveBakers
+migratePersistentBirkParameters migration accounts mActiveBakers PersistentBirkParameters{..} = do
+    newActiveBakers <- case mActiveBakers of
+        CTrue ab -> refMake ab
+        CFalse -> migrateReference (migratePersistentActiveBakers migration accounts) _birkActiveBakers
     newNextEpochBakers <- migrateHashedBufferedRef (migratePersistentEpochBakers migration) _birkNextEpochBakers
     newCurrentEpochBakers <- migrateHashedBufferedRef (migratePersistentEpochBakers migration) _birkCurrentEpochBakers
     return
@@ -3789,7 +3792,8 @@ migrateBlockPointers migration BlockStatePointers{..} = do
             StateMigrationParametersP6ToP7{} -> RSMNewToNew
     newReleaseSchedule <- migrateReleaseSchedule rsMigration bspReleaseSchedule
     pab <- lift . refLoad $ bspBirkParameters ^. birkActiveBakers
-    initMigrationState :: MigrationState.AccountMigrationState oldpv pv <- MigrationState.makeInitialAccountMigrationState bspAccounts pab
+    initMigrationState :: MigrationState.AccountMigrationState oldpv pv <-
+        MigrationState.makeInitialAccountMigrationState bspAccounts pab
     (newAccounts, migrationState) <-
         MigrationState.runAccountMigrationStateTT
             (Accounts.migrateAccounts migration bspAccounts)
@@ -3805,7 +3809,12 @@ migrateBlockPointers migration BlockStatePointers{..} = do
     newIdentityProviders <- migrateHashedBufferedRefKeepHash bspIdentityProviders
     newAnonymityRevokers <- migrateHashedBufferedRefKeepHash bspAnonymityRevokers
     let oldEpoch = bspBirkParameters ^. birkSeedState . epoch
-    newBirkParameters <- migratePersistentBirkParameters migration newAccounts bspBirkParameters
+    newBirkParameters <-
+        migratePersistentBirkParameters
+            migration
+            newAccounts
+            (MigrationState._persistentActiveBakers migrationState)
+            bspBirkParameters
     newCryptographicParameters <- migrateHashedBufferedRefKeepHash bspCryptographicParameters
     newUpdates <- migrateReference (migrateUpdates migration) bspUpdates
     curBakers <- extractBakerStakes =<< refLoad (_birkCurrentEpochBakers newBirkParameters)

From cde34d595a41db042c92c0d87e7bb8b6a2d5cca9 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Thu, 23 May 2024 13:20:45 +0200
Subject: [PATCH 11/81] Migration testing. Renaming some stake related
 functions and exposing cooldowns on accounts.

---
 .../src/Concordium/GlobalState/BlockState.hs  |  11 +-
 .../Concordium/GlobalState/CooldownQueue.hs   |  22 ++
 .../GlobalState/Persistent/Account.hs         |  41 +-
 .../Persistent/Account/CooldownQueue.hs       |  15 +-
 .../Persistent/Account/MigrationState.hs      |   6 +-
 .../Persistent/Account/StructureV0.hs         |   4 +-
 .../Persistent/Account/StructureV1.hs         |  51 ++-
 .../GlobalState/Persistent/BlockState.hs      |   9 +-
 .../GlobalState/Persistent/Cooldown.hs        |   7 +
 .../src/Concordium/Scheduler.hs               |   2 +-
 .../src/Concordium/Scheduler/Environment.hs   |   2 +-
 .../globalstate/GlobalStateTests/Accounts.hs  |   7 +-
 .../AccountsMigrationP6ToP7.hs                | 364 ++++++++++++++++++
 .../GlobalStateTests/EnduringDataFlags.hs     |   2 +-
 .../tests/globalstate/Spec.hs                 |   2 +
 15 files changed, 501 insertions(+), 44 deletions(-)
 create mode 100644 concordium-consensus/tests/globalstate/GlobalStateTests/AccountsMigrationP6ToP7.hs

diff --git a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs
index ab12f4b30..4b38ca325 100644
--- a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs
@@ -167,9 +167,9 @@ class (BlockStateTypes m, Monad m) => AccountOperations m where
     -- | Check whether an account is allowed to perform the given action.
     checkAccountIsAllowed :: Account m -> AccountAllowance -> m Bool
 
-    -- | Get the amount that is staked on the account.
+    -- | Get the amount that is staked on the account, both active and inactive (P7 onwards).
     --  This is 0 if the account is not staking or delegating.
-    getAccountStakedAmount :: Account m -> m Amount
+    getAccountTotalStakedAmount :: Account m -> m Amount
 
     -- | Get the amount that is locked in scheduled releases on the account.
     --  This is 0 if there are no pending releases on the account.
@@ -179,11 +179,6 @@ class (BlockStateTypes m, Monad m) => AccountOperations m where
     -- This accounts for lock-up and staked amounts.
     -- @available = total - max locked staked@
     getAccountAvailableAmount :: Account m -> m Amount
-    getAccountAvailableAmount acc = do
-        total <- getAccountAmount acc
-        lockedUp <- getAccountLockedAmount acc
-        staked <- getAccountStakedAmount acc
-        return $ total - max lockedUp staked
 
     -- | Get the next available nonce for this account
     getAccountNonce :: Account m -> m Nonce
@@ -1541,7 +1536,7 @@ instance (Monad (t m), MonadTrans t, AccountOperations m) => AccountOperations (
     getAccountCanonicalAddress = lift . getAccountCanonicalAddress
     getAccountAmount = lift . getAccountAmount
     checkAccountIsAllowed acc = lift . checkAccountIsAllowed acc
-    getAccountStakedAmount = lift . getAccountStakedAmount
+    getAccountTotalStakedAmount = lift . getAccountTotalStakedAmount
     getAccountLockedAmount = lift . getAccountLockedAmount
     getAccountAvailableAmount = lift . getAccountAvailableAmount
     getAccountNonce = lift . getAccountNonce
diff --git a/concordium-consensus/src/Concordium/GlobalState/CooldownQueue.hs b/concordium-consensus/src/Concordium/GlobalState/CooldownQueue.hs
index 523cd3f39..368350e13 100644
--- a/concordium-consensus/src/Concordium/GlobalState/CooldownQueue.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/CooldownQueue.hs
@@ -11,7 +11,9 @@ import qualified Data.Bits as Bits
 import qualified Data.Map.Strict as Map
 import Data.Serialize
 
+import qualified Concordium.Crypto.SHA256 as Hash
 import Concordium.Types
+import Concordium.Types.HashableTo
 import Concordium.Utils.Serialization
 
 import Concordium.GlobalState.Persistent.BlobStore
@@ -70,3 +72,23 @@ isEmptyCooldowns Cooldowns{..} =
     Map.null inCooldown
         && null preCooldown
         && null prePreCooldown
+
+-- | A 'Cooldowns' with no stake in cooldown, pre-cooldown or pre-pre-cooldown.
+emptyCooldowns :: Cooldowns
+emptyCooldowns =
+    Cooldowns
+        { inCooldown = Map.empty,
+          preCooldown = Absent,
+          prePreCooldown = Absent
+        }
+
+-- | The total amount in cooldown, pre-cooldown and pre-pre-cooldown.
+cooldownTotal :: Cooldowns -> Amount
+cooldownTotal Cooldowns{..} =
+    sum (Map.elems inCooldown)
+        + fromOption 0 preCooldown
+        + fromOption 0 prePreCooldown
+
+-- FIXME: Decide if we want to use the serialization for hashing.
+instance HashableTo Hash.Hash Cooldowns where
+    getHash = getHash . encode
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs
index 879368c5d..5b4553ac6 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs
@@ -27,6 +27,7 @@ import Concordium.GlobalState.Account
 import Concordium.GlobalState.BakerInfo
 import qualified Concordium.GlobalState.Basic.BlockState.Account as Transient
 import Concordium.GlobalState.BlockState (AccountAllowance)
+import Concordium.GlobalState.CooldownQueue
 import Concordium.GlobalState.Persistent.Account.MigrationStateInterface
 import qualified Concordium.GlobalState.Persistent.Account.StructureV0 as V0
 import qualified Concordium.GlobalState.Persistent.Account.StructureV1 as V1
@@ -119,18 +120,28 @@ accountAmount (PAV2 acc) = V1.getAmount acc
 accountAmount (PAV3 acc) = V1.getAmount acc
 
 -- | Gets the amount of a baker's stake, or 'Nothing' if the account is not a baker.
+--  This consists only of the active stake, and does not include any inactive stake.
 accountBakerStakeAmount :: (MonadBlobStore m) => PersistentAccount av -> m (Maybe Amount)
 accountBakerStakeAmount (PAV0 acc) = V0.getBakerStakeAmount acc
 accountBakerStakeAmount (PAV1 acc) = V0.getBakerStakeAmount acc
 accountBakerStakeAmount (PAV2 acc) = V1.getBakerStakeAmount acc
 accountBakerStakeAmount (PAV3 acc) = V1.getBakerStakeAmount acc
 
--- | Get the amount that is staked on the account.
-accountStakedAmount :: (MonadBlobStore m) => PersistentAccount av -> m Amount
-accountStakedAmount (PAV0 acc) = V0.getStakedAmount acc
-accountStakedAmount (PAV1 acc) = V0.getStakedAmount acc
-accountStakedAmount (PAV2 acc) = V1.getStakedAmount acc
-accountStakedAmount (PAV3 acc) = V1.getStakedAmount acc
+-- | Get the amount that is actively staked on an account as a baker or delegator.
+accountActiveStakedAmount :: (MonadBlobStore m) => PersistentAccount av -> m Amount
+accountActiveStakedAmount (PAV0 acc) = V0.getStakedAmount acc
+accountActiveStakedAmount (PAV1 acc) = V0.getStakedAmount acc
+accountActiveStakedAmount (PAV2 acc) = V1.getActiveStakedAmount acc
+accountActiveStakedAmount (PAV3 acc) = V1.getActiveStakedAmount acc
+
+-- | Get the amount that is staked on the account (both active and inactive).
+accountTotalStakedAmount :: (MonadBlobStore m) => PersistentAccount av -> m Amount
+accountTotalStakedAmount (PAV0 acc) = V0.getStakedAmount acc
+accountTotalStakedAmount (PAV1 acc) = V0.getStakedAmount acc
+accountTotalStakedAmount (PAV2 acc) =
+    -- This is the same as the total staked amount in account version 2.
+    V1.getActiveStakedAmount acc
+accountTotalStakedAmount (PAV3 acc) = V1.getTotalStakedAmount acc
 
 -- | Get the amount that is locked in scheduled releases on the account.
 accountLockedAmount :: (MonadBlobStore m) => PersistentAccount av -> m Amount
@@ -245,11 +256,11 @@ accountStake (PAV2 acc) = V1.getStake acc
 accountStake (PAV3 acc) = V1.getStake acc
 
 -- | Determine if an account has stake as a baker or delegator.
-accountHasStake :: PersistentAccount av -> Bool
-accountHasStake (PAV0 acc) = V0.hasStake acc
-accountHasStake (PAV1 acc) = V0.hasStake acc
-accountHasStake (PAV2 acc) = V1.hasStake acc
-accountHasStake (PAV3 acc) = V1.hasStake acc
+accountHasActiveStake :: PersistentAccount av -> Bool
+accountHasActiveStake (PAV0 acc) = V0.hasActiveStake acc
+accountHasActiveStake (PAV1 acc) = V0.hasActiveStake acc
+accountHasActiveStake (PAV2 acc) = V1.hasActiveStake acc
+accountHasActiveStake (PAV3 acc) = V1.hasActiveStake acc
 
 -- | Get details about an account's stake.
 accountStakeDetails :: (MonadBlobStore m) => PersistentAccount av -> m (StakeDetails av)
@@ -258,6 +269,14 @@ accountStakeDetails (PAV1 acc) = V0.getStakeDetails acc
 accountStakeDetails (PAV2 acc) = V1.getStakeDetails acc
 accountStakeDetails (PAV3 acc) = V1.getStakeDetails acc
 
+-- | Get the 'Cooldowns' for an account, if any. This is only available at account versions that
+-- support flexible cooldowns.
+accountCooldowns ::
+    (MonadBlobStore m, SupportsFlexibleCooldown av ~ 'True) =>
+    PersistentAccount av ->
+    m (Maybe Cooldowns)
+accountCooldowns (PAV3 acc) = V1.getCooldowns acc
+
 -- | Get the 'AccountHash' for the account.
 accountHash :: (MonadBlobStore m) => PersistentAccount av -> m (AccountHash av)
 accountHash (PAV0 acc) = getHashM acc
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/CooldownQueue.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/CooldownQueue.hs
index 3ac85092e..4cf37043b 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/CooldownQueue.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/CooldownQueue.hs
@@ -58,8 +58,14 @@ instance forall m av. (MonadBlobStore m, IsAccountVersion av) => BlobStorable m
         ofNullable Null = EmptyCooldownQueue
         ofNullable (Some queue) = CooldownQueue queue
 
-instance HashableTo (CooldownQueueHash av) (CooldownQueue av) where
-    getHash _ = undefined -- FIXME: Define
+-- | The has of 'EmptyCooldownQueue'.
+emptyCooldownQueueHash :: CooldownQueueHash av
+{-# NOINLINE emptyCooldownQueueHash #-}
+emptyCooldownQueueHash = CooldownQueueHash (getHash emptyCooldowns)
+
+instance (MonadBlobStore m) => MHashableTo m (CooldownQueueHash av) (CooldownQueue av) where
+    getHashM EmptyCooldownQueue = return emptyCooldownQueueHash
+    getHashM (CooldownQueue ref) = CooldownQueueHash . getHash <$> refLoad ref
 
 -- | The empty 'CooldownQueue'.
 emptyCooldownQueue :: CooldownQueue av
@@ -103,6 +109,11 @@ migrateCooldownQueue EmptyCooldownQueue = return EmptyCooldownQueue
 migrateCooldownQueue (CooldownQueue queueRef) =
     CooldownQueue <$> migrateEagerBufferedRef return queueRef
 
+-- | Get the total stake in cooldown, pre-cooldown and pre-pre-cooldown.
+cooldownStake :: CooldownQueue av -> Amount
+cooldownStake EmptyCooldownQueue = 0
+cooldownStake (CooldownQueue queueRef) = cooldownTotal $ eagerBufferedDeref queueRef
+
 {-
 -- | Convert a 'Cooldowns' to a 'CooldownQueue', using 'EmptyCooldownQueue' for the case where
 --  there are no cooldowns.
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationState.hs
index 9ee0058c9..ffcf5029e 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationState.hs
@@ -234,5 +234,9 @@ instance
                                 ++ " (delegated to by "
                                 ++ show delId
                                 ++ ") is not a baker."
-                    Right newPAB -> persistentActiveBakers .= CTrue newPAB
+                    Right newPAB -> do
+                        -- Note that addDelegator does not change the total active capital, so
+                        -- we do it here.
+                        persistentActiveBakers
+                            .= CTrue (newPAB & totalActiveCapital %~ addActiveCapital delAmt)
             CFalse -> return ()
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV0.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV0.hs
index e288fa321..c702af69c 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV0.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV0.hs
@@ -744,8 +744,8 @@ getStake :: (MonadBlobStore m, IsAccountVersion av, AVStructureV0 av) => Persist
 getStake acc = loadAccountStake (acc ^. accountStake)
 
 -- | Determine if an account has stake as a baker or delegator.
-hasStake :: PersistentAccount av -> Bool
-hasStake acc = case acc ^. accountStake of
+hasActiveStake :: PersistentAccount av -> Bool
+hasActiveStake acc = case acc ^. accountStake of
     PersistentAccountStakeNone -> False
     _ -> True
 
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
index f74e51779..e7418c286 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
@@ -42,6 +42,7 @@ import qualified Concordium.GlobalState.Basic.BlockState.Account as Transient
 import qualified Concordium.GlobalState.Basic.BlockState.AccountReleaseSchedule as TARS
 import qualified Concordium.GlobalState.Basic.BlockState.AccountReleaseScheduleV1 as TARSV1
 import Concordium.GlobalState.BlockState (AccountAllowance (..))
+import Concordium.GlobalState.CooldownQueue
 import Concordium.GlobalState.Persistent.Account.CooldownQueue
 import Concordium.GlobalState.Persistent.Account.EncryptedAmount
 import Concordium.GlobalState.Persistent.Account.MigrationStateInterface
@@ -226,6 +227,7 @@ migratePersistentAccountStakeEnduringV2toV3 PersistentAccountStakeEnduringBaker{
             -- The baker is being removed, so we don't migrate it.
             cooldownAmount <- id <<.= 0 -- Get the old stake, updating it to 0.
             cooldown <- initialPrePreCooldownQueue cooldownAmount
+            lift addAccountInPrePreCooldown
             return (PersistentAccountStakeEnduringNone, cooldown)
         ReduceStake newStake _ -> do
             oldStake <- State.get
@@ -237,6 +239,7 @@ migratePersistentAccountStakeEnduringV2toV3 PersistentAccountStakeEnduringBaker{
                         ++ show newStake
             State.put newStake
             cooldown <- initialPrePreCooldownQueue (oldStake - newStake)
+            lift addAccountInPrePreCooldown
             newPASE <- keepBakerInfo
             return (newPASE, cooldown)
         NoChange -> (,emptyCooldownQueue) <$> keepBakerInfo
@@ -254,6 +257,7 @@ migratePersistentAccountStakeEnduringV2toV3 PersistentAccountStakeEnduringDelega
         RemoveStake _ -> do
             cooldownAmount <- id <<.= 0 -- Get the old stake, updating it to 0.
             cooldown <- initialPrePreCooldownQueue cooldownAmount
+            lift addAccountInPrePreCooldown
             return (PersistentAccountStakeEnduringNone, cooldown)
         _ -> do
             newTarget <- case paseDelegatorTarget of
@@ -280,7 +284,9 @@ migratePersistentAccountStakeEnduringV2toV3 PersistentAccountStakeEnduringDelega
                                 ++ show newStake
                     State.put newStake
                     cooldown <- initialPrePreCooldownQueue (oldStake - newStake)
-                    lift $ retainDelegator paseDelegatorId newStake newTarget
+                    lift $ do
+                        addAccountInPrePreCooldown
+                        retainDelegator paseDelegatorId newStake newTarget
                     return $!! (newDelegatorInfo, cooldown)
                 NoChange -> do
                     lift $ retainDelegator paseDelegatorId oldStake newTarget
@@ -390,7 +396,7 @@ makeAccountEnduringDataAV3 paedPersistingData paedEncryptedAmount paedReleaseSch
     amhi3AccountReleaseScheduleHash <- case paedReleaseSchedule of
         Null -> return TARSV1.emptyAccountReleaseScheduleHashV1
         Some (rs, _) -> getHashM rs
-    let amhi3Cooldown = getHash paedStakeCooldown
+    amhi3Cooldown <- getHashM paedStakeCooldown
     let hashInputs :: AccountMerkleHashInputs 'AccountV3
         hashInputs = AccountMerkleHashInputsV3{..}
         !paedHash = getHash hashInputs
@@ -421,7 +427,7 @@ rehashAccountEnduringDataAV3 ed = do
     amhi3AccountReleaseScheduleHash <- case paedReleaseSchedule ed of
         Null -> return TARSV1.emptyAccountReleaseScheduleHashV1
         Some (rs, _) -> getHashM rs
-    let amhi3Cooldown = getHash $ paedStakeCooldown ed
+    amhi3Cooldown <- getHashM $ paedStakeCooldown ed
     let hashInputs :: AccountMerkleHashInputs 'AccountV3
         hashInputs = AccountMerkleHashInputsV3{..}
     return $! ed{paedHash = getHash hashInputs}
@@ -489,7 +495,8 @@ pendingChangeFlagsFromBits _ = Left "Invalid pending change type"
 --
 --  - Bits 5 and 4 indicate the staking status of the account:
 --
---    - If bits 5 and 4 are unset, there is no staking. The remaining bit are also unset.
+--    - If bits 5 and 4 are unset, there is no staking. Bit 0 is set if there is stake in cooldown.
+--      All other bits are unset.
 --
 --    - If bit 5 is unset and bit 4 is set, the account is a baker. In this case
 --
@@ -820,9 +827,18 @@ getBakerStakeAmount acc = do
         PersistentAccountStakeEnduringBaker{} -> Just $! accountStakedAmount acc
         _ -> Nothing
 
--- | Get the amount that is staked on the account.
-getStakedAmount :: (Monad m) => PersistentAccount av -> m Amount
-getStakedAmount acc = return $! accountStakedAmount acc
+-- | Get the amount that is actively staked on the account.
+getActiveStakedAmount :: (Monad m) => PersistentAccount av -> m Amount
+getActiveStakedAmount acc = return $! accountStakedAmount acc
+
+-- | Get the total amount that is staked on the account including the active stake (for a validator
+-- or delegator) and the inactive stake (in cooldown).
+-- For account versions prior to 'AccountV3', this is the same as 'getActiveStakedAmount'.
+getTotalStakedAmount :: (Monad m) => PersistentAccount av -> m Amount
+getTotalStakedAmount acc = return $! activeStake + inactiveStake
+  where
+    activeStake = accountStakedAmount acc
+    inactiveStake = cooldownStake $ paedStakeCooldown (enduringData acc)
 
 -- | Get the amount that is locked in scheduled releases on the account.
 getLockedAmount :: (Monad m) => PersistentAccount av -> m Amount
@@ -832,11 +848,15 @@ getLockedAmount acc = do
 
 -- | Get the current public account available balance.
 -- This accounts for lock-up and staked amounts.
--- @available = total - max locked staked@
+-- @available = total - max locked staked@ where
+-- @staked = active + inactive@.
 getAvailableAmount :: (Monad m) => PersistentAccount av -> m Amount
 getAvailableAmount acc = do
     let ed = enduringData acc
-    return $! accountAmount acc - max (accountStakedAmount acc) (paedLockedAmount ed)
+        activeStake = accountStakedAmount acc
+        inactiveStake = cooldownStake $ paedStakeCooldown ed
+        stake = activeStake + inactiveStake
+    return $! accountAmount acc - max stake (paedLockedAmount ed)
 
 -- | Get the next account nonce for transactions from this account.
 getNonce :: (Monad m) => PersistentAccount av -> m Nonce
@@ -984,8 +1004,8 @@ getStake acc = do
     persistentToAccountStake (paedStake ed) (accountStakedAmount acc)
 
 -- | Determine if an account has stake as a baker or delegator.
-hasStake :: PersistentAccount av -> Bool
-hasStake acc = case paedStake (enduringData acc) of
+hasActiveStake :: PersistentAccount av -> Bool
+hasActiveStake acc = case paedStake (enduringData acc) of
     PersistentAccountStakeEnduringNone -> False
     _ -> True
 
@@ -1017,6 +1037,15 @@ getStakeCooldown acc = do
     let ed = enduringData acc
     return $ paedStakeCooldown ed
 
+getCooldowns ::
+    (MonadBlobStore m, SupportsFlexibleCooldown av ~ 'True) =>
+    PersistentAccount av ->
+    m (Maybe Cooldowns)
+getCooldowns =
+    getStakeCooldown >=> \case
+        EmptyCooldownQueue -> return Nothing
+        CooldownQueue ref -> Just <$> refLoad ref
+
 -- ** Updates
 
 -- | Apply account updates to an account. It is assumed that the address in
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
index 55db3001f..ac682a7bd 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
@@ -398,7 +398,7 @@ initialBirkParameters accounts seedState _bakerFinalizationCommitteeParameters =
 
                 nextBakerIds <- Trie.insert bakerId activeDelegators $ aibpBakerIds accum
                 nextBakerKeys <- Trie.insert aggregationKey () $ aibpBakerKeys accum
-                stake <- accountStakedAmount account
+                stake <- accountActiveStakedAmount account
 
                 return
                     updatedAccum
@@ -1453,8 +1453,8 @@ doAddBaker pbs ai ba@BakerAdd{..} = do
         -- Cannot resolve the account
         Nothing -> return (BAInvalidAccount, pbs)
         Just acct
-            -- Account is already a baker
-            | accountHasStake acct -> return (BAAlreadyBaker (BakerId ai), pbs)
+            -- Account is already a baker. (NB: cannot be a delegator at AccountV0.)
+            | accountHasActiveStake acct -> return (BAAlreadyBaker (BakerId ai), pbs)
             -- Account is not a baker
             | otherwise -> do
                 cp <- (^. cpPoolParameters . ppBakerStakeThreshold) <$> lookupCurrentParameters (bspUpdates bsp)
@@ -3562,7 +3562,7 @@ instance (PersistentState av pv r m, IsProtocolVersion pv) => AccountOperations
 
     getAccountAmount = accountAmount
 
-    getAccountStakedAmount = accountStakedAmount
+    getAccountTotalStakedAmount = accountTotalStakedAmount
 
     getAccountLockedAmount = accountLockedAmount
 
@@ -3792,6 +3792,7 @@ migrateBlockPointers migration BlockStatePointers{..} = do
             StateMigrationParametersP6ToP7{} -> RSMNewToNew
     newReleaseSchedule <- migrateReleaseSchedule rsMigration bspReleaseSchedule
     pab <- lift . refLoad $ bspBirkParameters ^. birkActiveBakers
+    -- When we migrate the accounts, we accumulate state
     initMigrationState :: MigrationState.AccountMigrationState oldpv pv <-
         MigrationState.makeInitialAccountMigrationState bspAccounts pab
     (newAccounts, migrationState) <-
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Cooldown.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Cooldown.hs
index 037c05b23..88ce6812c 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Cooldown.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Cooldown.hs
@@ -35,6 +35,13 @@ instance (MonadBlobStore m) => BlobStorable m AccountListItem where
 -- | A possibly empty list of 'AccountIndex'es, stored under 'UnbufferedRef's.
 type AccountList = Nullable (UnbufferedRef AccountListItem)
 
+-- | Load an entire account list. This is intended for testing purposes.
+loadAccountList :: (MonadBlobStore m) => AccountList -> m [AccountIndex]
+loadAccountList Null = return []
+loadAccountList (Some ref) = do
+    AccountListItem{..} <- refLoad ref
+    (accountListEntry :) <$> loadAccountList accountListTail
+
 -- | Migrate an 'AccountList' from one context to another.
 migrateAccountList :: (SupportMigration m t) => AccountList -> t m AccountList
 migrateAccountList Null = return Null
diff --git a/concordium-consensus/src/Concordium/Scheduler.hs b/concordium-consensus/src/Concordium/Scheduler.hs
index 19e47c6ab..bd931a022 100644
--- a/concordium-consensus/src/Concordium/Scheduler.hs
+++ b/concordium-consensus/src/Concordium/Scheduler.hs
@@ -1357,7 +1357,7 @@ handleContractUpdateV1 originAddr istance checkAndGetSender transferAmount recei
                                                 balance <- getCurrentAccountTotalAmount indexedAccount
                                                 -- During this transaction the staked and locked amount could not have been affected.
                                                 -- Hence we can simply take the relevant balance from the "state account".
-                                                stake <- getAccountStakedAmount account
+                                                stake <- getAccountTotalStakedAmount account
                                                 lockedAmount <- getAccountLockedAmount account
                                                 -- Construct the return value.
                                                 let returnValue = WasmV1.byteStringToReturnValue $ S.runPut $ do
diff --git a/concordium-consensus/src/Concordium/Scheduler/Environment.hs b/concordium-consensus/src/Concordium/Scheduler/Environment.hs
index 6c7401ae0..b5894ed35 100644
--- a/concordium-consensus/src/Concordium/Scheduler/Environment.hs
+++ b/concordium-consensus/src/Concordium/Scheduler/Environment.hs
@@ -1218,7 +1218,7 @@ instance (MonadProtocolVersion m, StaticInformation m, AccountOperations m, Cont
     getCurrentAccountAvailableAmount (ai, acc) = do
         oldTotal <- getAccountAmount acc
         oldLockedUp <- getAccountLockedAmount acc
-        staked <- getAccountStakedAmount acc
+        staked <- getAccountTotalStakedAmount acc
         !txCtx <- ask
         -- If the account is the sender, subtract the deposit
         let netDeposit =
diff --git a/concordium-consensus/tests/globalstate/GlobalStateTests/Accounts.hs b/concordium-consensus/tests/globalstate/GlobalStateTests/Accounts.hs
index 08d74272b..7dd07d627 100644
--- a/concordium-consensus/tests/globalstate/GlobalStateTests/Accounts.hs
+++ b/concordium-consensus/tests/globalstate/GlobalStateTests/Accounts.hs
@@ -46,7 +46,7 @@ import Test.Hspec
 import Test.QuickCheck
 import Prelude hiding (fail)
 
-type PV = 'P5
+type PV = 'P6
 
 newtype NoLoggerT m a = NoLoggerT {runNoLoggerT :: m a}
     deriving (Functor, Applicative, Monad, MonadIO, MonadReader r, MonadFail)
@@ -278,7 +278,10 @@ tests lvl = describe "GlobalStateTests.Accounts"
                         pbscAccountMap <- LMDBAccountMap.openDatabase (dir </> "accountmap")
                         return PersistentBlockStateContext{..}
                     )
-                    (closeBlobStore . pbscBlobStore)
+                    ( \PersistentBlockStateContext{..} -> do
+                        closeBlobStore pbscBlobStore
+                        LMDBAccountMap.closeDatabase pbscAccountMap
+                    )
                     kont
         )
     $ do
diff --git a/concordium-consensus/tests/globalstate/GlobalStateTests/AccountsMigrationP6ToP7.hs b/concordium-consensus/tests/globalstate/GlobalStateTests/AccountsMigrationP6ToP7.hs
new file mode 100644
index 000000000..8d743e868
--- /dev/null
+++ b/concordium-consensus/tests/globalstate/GlobalStateTests/AccountsMigrationP6ToP7.hs
@@ -0,0 +1,364 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE MonoLocalBinds #-}
+{-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+-- | This module tests the migration of accounts from protocol version 6 to protocol version 7.
+-- In particular, it tests that bakers and delegators are migrated correctly, with any bakers
+-- or delegators that are in cooldown (for removal or stake reduction) are moved to cooldown after
+-- migration. Specifically:
+--
+--  * Bakers/delegators that are in cooldown for removal are removed and have their stake put in
+--    pre-pre-cooldown.
+--  * Bakers/delegators that are in cooldown for reduction have their stake reduced and the
+--    reduction put in pre-pre-cooldown.
+--  * Any account that is put in pre-pre-cooldown is recorded in 'migrationPrePreCooldown'.
+--  * Delegators to bakers that are removed (as a result of migration) are moved to passive
+--    delegation.
+--  * All bakers and delegators that are not removed are correctly recorded in the persistent
+--    active bakers.
+module GlobalStateTests.AccountsMigrationP6ToP7 where
+
+import Test.HUnit
+import Test.Hspec
+
+import Concordium.Types
+import Concordium.Types.Accounts
+
+import qualified Concordium.Crypto.BlockSignature as Sig
+import qualified Concordium.Crypto.BlsSignature as Bls
+import qualified Concordium.Crypto.VRF as VRF
+import Concordium.Genesis.Data
+import Concordium.GlobalState.Account
+import qualified Concordium.GlobalState.AccountMap.LMDB as LMDBAccountMap
+import qualified Concordium.GlobalState.Basic.BlockState.Account as Transient
+import qualified Concordium.GlobalState.Basic.BlockState.AccountReleaseSchedule as Transient
+import qualified Concordium.GlobalState.Basic.BlockState.CooldownQueue as Transient
+import Concordium.GlobalState.CooldownQueue
+import Concordium.GlobalState.DummyData
+import Concordium.GlobalState.Persistent.Account
+import qualified Concordium.GlobalState.Persistent.Account.MigrationState as MigrationState
+import Concordium.GlobalState.Persistent.Accounts
+import Concordium.GlobalState.Persistent.Bakers
+import Concordium.GlobalState.Persistent.BlobStore
+import Concordium.GlobalState.Persistent.BlockState
+import qualified Concordium.GlobalState.Persistent.BlockState.Modules as M
+import Concordium.GlobalState.Persistent.Cooldown
+import qualified Concordium.GlobalState.Persistent.Trie as Trie
+import Concordium.ID.Types
+import Concordium.Scheduler.DummyData
+import Concordium.Types.Conditionally
+import Concordium.Types.DummyData
+import Concordium.Types.Execution
+import Concordium.Types.Option
+import Control.Exception
+import Control.Monad
+import Control.Monad.IO.Class
+import qualified Data.Map.Strict as Map
+import GlobalStateTests.Accounts (NoLoggerT (..))
+import Lens.Micro.Platform
+import System.FilePath
+import System.IO.Temp
+
+dummyPersisingAccountData :: Int -> PersistingAccountData
+dummyPersisingAccountData seed =
+    PersistingAccountData
+        { _accountAddress = addr,
+          _accountEncryptionKey = encryptionKey,
+          _accountVerificationKeys = getAccountInformation 1 creds,
+          _accountCredentials = creds,
+          _accountRemovedCredentials = makeHashed EmptyRemovedCredentials
+        }
+  where
+    cred = makeTestCredentialFromSeed seed
+    creds = Map.singleton 0 (toRawAccountCredential cred)
+    addr = accountAddressFromSeed seed
+    encryptionKey = toRawEncryptionKey (makeEncryptionKey dummyCryptographicParameters (credId cred))
+
+-- | Create a test account with the given persisting data and stake.
+--  The balance of the account is set to 1 billion CCD (10^15 uCCD).
+testAccount :: (IsAccountVersion av) => PersistingAccountData -> AccountStake av -> Transient.Account av
+testAccount persisting stake =
+    Transient.Account
+        { _accountPersisting = Transient.makeAccountPersisting persisting,
+          _accountNonce = minNonce,
+          _accountAmount = 1_000_000_000_000_000,
+          _accountEncryptedAmount = initialAccountEncryptedAmount,
+          _accountReleaseSchedule = Transient.emptyAccountReleaseSchedule,
+          _accountStaking = stake,
+          _accountStakeCooldown = Transient.emptyCooldownQueue
+        }
+
+-- | Initial stake for a test account, set to 500 million CCD plus @2^accountIndex@ uCCD.
+initialStake :: AccountIndex -> Amount
+initialStake accIndex = 500_000_000_000_000 + 2 ^ accIndex
+
+-- | Target reduced stake for a test account, set to 10_000 CCD plus @2^accountIndex@ uCCD.
+reducedStake :: AccountIndex -> Amount
+reducedStake accIndex = 10_000_000_000 + 2 ^ accIndex
+
+-- | Create a baker stake for a given (small (<38)) account index. The stake is set at 500 million
+-- CCD plus @2^accountIndex@ uCCD. This is to ensure that any given combination of accounts have a
+-- unique total stake.
+dummyBakerStake ::
+    (AVSupportsDelegation av) =>
+    (AccountIndex -> Amount) ->
+    AccountIndex ->
+    StakePendingChange av ->
+    AccountStake av
+dummyBakerStake compStake accIndex pc =
+    AccountStakeBaker $
+        AccountBaker
+            { _stakedAmount = compStake accIndex,
+              _stakeEarnings = True,
+              _bakerPendingChange = pc,
+              _accountBakerInfo =
+                BakerInfoExV1
+                    { _bieBakerPoolInfo =
+                        BakerPoolInfo
+                            { _poolOpenStatus = OpenForAll,
+                              _poolMetadataUrl = emptyUrlText,
+                              _poolCommissionRates =
+                                CommissionRates
+                                    { _finalizationCommission = makeAmountFraction 50_000,
+                                      _bakingCommission = makeAmountFraction 50_000,
+                                      _transactionCommission = makeAmountFraction 50_000
+                                    }
+                            },
+                      _bieBakerInfo =
+                        BakerInfo
+                            { _bakerSignatureVerifyKey = Sig.verifyKey (bakerSignKey seed),
+                              _bakerIdentity = BakerId accIndex,
+                              _bakerElectionVerifyKey = VRF.publicKey (bakerElectionKey seed),
+                              _bakerAggregationVerifyKey =
+                                Bls.derivePublicKey (bakerAggregationKey seed)
+                            }
+                    }
+            }
+  where
+    seed = fromIntegral accIndex
+
+dummyDelegatorStake ::
+    (AVSupportsDelegation av) =>
+    (AccountIndex -> Amount) ->
+    AccountIndex ->
+    DelegationTarget ->
+    StakePendingChange av ->
+    AccountStake av
+dummyDelegatorStake compStake accIndex target pc =
+    AccountStakeDelegate $
+        AccountDelegationV1
+            { _delegationTarget = target,
+              _delegationStakedAmount = compStake accIndex,
+              _delegationStakeEarnings = True,
+              _delegationPendingChange = pc,
+              _delegationIdentity = DelegatorId accIndex
+            }
+
+-- | Create a set of test accounts for migration testing.
+--  The accounts consist of 3 bakers, one with no pending changes, one with a reduction and one
+--  with a removal. Each baker has 3 delegators, one with no pending changes, one with a reduction
+--  and one with a removal. There are also 3 passive delegators, similarly configured.
+setupTestAccounts :: (SupportsPersistentAccount 'P6 m, MonadFail m) => m (Accounts 'P6)
+setupTestAccounts = do
+    a0 <- mkBakerAccount 0 NoChange
+    a1 <- mkBakerAccount 1 (ReduceStake (reducedStake 1) (PendingChangeEffectiveV1 1000))
+    a2 <- mkBakerAccount 2 (RemoveStake (PendingChangeEffectiveV1 2000))
+    a3 <- mkDelegatorAccount 3 (DelegateToBaker 0) NoChange
+    a4 <-
+        mkDelegatorAccount
+            4
+            (DelegateToBaker 0)
+            (ReduceStake (reducedStake 4) (PendingChangeEffectiveV1 3000))
+    a5 <- mkDelegatorAccount 5 (DelegateToBaker 0) (RemoveStake (PendingChangeEffectiveV1 4000))
+    a6 <- mkDelegatorAccount 6 (DelegateToBaker 1) NoChange
+    a7 <-
+        mkDelegatorAccount
+            7
+            (DelegateToBaker 1)
+            (ReduceStake (reducedStake 7) (PendingChangeEffectiveV1 5000))
+    a8 <- mkDelegatorAccount 8 (DelegateToBaker 1) (RemoveStake (PendingChangeEffectiveV1 6000))
+    a9 <- mkDelegatorAccount 9 (DelegateToBaker 2) NoChange
+    a10 <-
+        mkDelegatorAccount
+            10
+            (DelegateToBaker 2)
+            (ReduceStake (reducedStake 10) (PendingChangeEffectiveV1 7000))
+    a11 <- mkDelegatorAccount 11 (DelegateToBaker 2) (RemoveStake (PendingChangeEffectiveV1 8000))
+    a12 <- mkDelegatorAccount 12 DelegatePassive NoChange
+    a13 <-
+        mkDelegatorAccount
+            13
+            DelegatePassive
+            (ReduceStake (reducedStake 13) (PendingChangeEffectiveV1 9000))
+    a14 <- mkDelegatorAccount 14 DelegatePassive (RemoveStake (PendingChangeEffectiveV1 10_000))
+    accounts0 <- emptyAccounts
+    foldM
+        (\accts a -> snd <$> putNewAccount a accts)
+        accounts0
+        [a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14]
+  where
+    mkBakerAccount accIdx pc =
+        makePersistentAccount $
+            testAccount
+                (dummyPersisingAccountData (fromIntegral accIdx))
+                (dummyBakerStake initialStake accIdx pc)
+    mkDelegatorAccount accIndex target pc =
+        makePersistentAccount $
+            testAccount
+                (dummyPersisingAccountData (fromIntegral accIndex))
+                (dummyDelegatorStake initialStake accIndex target pc)
+
+initPersistentActiveBakers ::
+    forall pv m.
+    (SupportsPersistentAccount pv m, PVSupportsDelegation pv) =>
+    Accounts pv ->
+    m (PersistentActiveBakers (AccountVersionFor pv))
+initPersistentActiveBakers = foldAccounts addAcct emptyPersistentActiveBakers
+  where
+    addAcct pab acct =
+        accountStake acct >>= \case
+            AccountStakeNone -> return pab
+            AccountStakeBaker b -> do
+                let upd Nothing = return ((), Trie.Insert emptyPersistentActiveDelegators)
+                    upd _ = return ((), Trie.NoChange)
+                (_, newActiveBakers) <- Trie.adjust upd (b ^. bakerIdentity) (pab ^. activeBakers)
+                newAggregationKeys <-
+                    Trie.insert (b ^. bakerAggregationVerifyKey) () (pab ^. aggregationKeys)
+                return $!
+                    pab
+                        & activeBakers .~ newActiveBakers
+                        & totalActiveCapital . tacAmount +~ (b ^. stakedAmount)
+                        & aggregationKeys .~ newAggregationKeys
+            AccountStakeDelegate d -> do
+                (totalActiveCapital . tacAmount +~ delAmt)
+                    <$> case d ^. delegationTarget of
+                        DelegatePassive -> do
+                            passiveDelegators (addDelegatorHelper delId delAmt) pab
+                        DelegateToBaker bid -> do
+                            activeBakers (fmap snd . Trie.adjust upd bid) pab
+              where
+                delId = d ^. delegationIdentity
+                delAmt = d ^. delegationStakedAmount
+                upd Nothing = do
+                    singletonPAD <-
+                        addDelegatorHelper delId delAmt emptyPersistentActiveDelegators
+                    return ((), Trie.Insert singletonPAD)
+                upd (Just pad) = do
+                    newPAD <- addDelegatorHelper delId delAmt pad
+                    return ((), Trie.Insert newPAD)
+
+migrationTest :: PersistentBlockStateContext 'P6 -> PersistentBlockStateContext 'P7 -> Expectation
+migrationTest c0 c1 = runNoLoggerT $ flip runBlobStoreT c0 $ do
+    accounts <- setupTestAccounts
+    pab <- initPersistentActiveBakers accounts
+    flip runBlobStoreT c1 $ do
+        initMigrationState :: MigrationState.AccountMigrationState 'P6 'P7 <-
+            MigrationState.makeInitialAccountMigrationState accounts pab
+
+        (newAccounts :: Accounts 'P7, newMigrationState) <-
+            MigrationState.runAccountMigrationStateTT
+                (migrateAccounts @'P6 @'P7 StateMigrationParametersP6ToP7 accounts)
+                initMigrationState
+        assertMigrationStateCorrect newMigrationState
+        assertAccountsCorrect newAccounts
+        unless (accountDiffMapRef accounts == accountDiffMapRef newAccounts) $
+            liftIO $
+                assertFailure "Expected the same account difference map"
+
+-- | Assert that the accounts marked as in pre-pre-cooldown and the persistent active bakers are as
+--  expected after migration from the test accounts.
+assertMigrationStateCorrect :: forall m. (MonadBlobStore m) => MigrationState.AccountMigrationState 'P6 'P7 -> m ()
+assertMigrationStateCorrect migrationState = do
+    prePreCooldownList <- loadAccountList (migrationState ^. MigrationState.migrationPrePreCooldown . unconditionally)
+    -- All accounts that were in cooldown before migration should be in pre-pre-cooldown after migration.
+    let expectPrePreCooldownList = [14, 13, 11, 10, 8, 7, 5, 4, 2, 1]
+    liftIO $ assertEqual "Expected pre-pre-cooldown list" expectPrePreCooldownList prePreCooldownList
+    let pab = migrationState ^. MigrationState.persistentActiveBakers . unconditionally
+    let unDel :: PersistentActiveDelegators 'AccountV3 -> m ([DelegatorId], Amount)
+        unDel PersistentActiveDelegatorsV1{..} = (,adDelegatorTotalCapital) <$> Trie.keysAsc adDelegators
+    actBkrs <- mapM unDel =<< Trie.toMap (pab ^. activeBakers)
+    let expectActiveBakers =
+            Map.fromList
+                [ (0, ([3, 4], initialStake 3 + reducedStake 4)),
+                  (1, ([6, 7], initialStake 6 + reducedStake 7))
+                ]
+    liftIO $ assertEqual "Active bakers" expectActiveBakers actBkrs
+    aggKeys <- Trie.keys (pab ^. aggregationKeys)
+    -- Note: the aggregation keys happen to be in this order. Technically the order doesn't matter.
+    let expectAggreationKeys = Bls.derivePublicKey . bakerAggregationKey <$> [0, 1]
+    liftIO $ assertEqual "Aggregation keys" expectAggreationKeys aggKeys
+    pasvDlg <- unDel (pab ^. passiveDelegators)
+    let expectPassiveDelegators = ([9, 10, 12, 13], initialStake 9 + reducedStake 10 + initialStake 12 + reducedStake 13)
+    liftIO $ assertEqual "Passive delegators" expectPassiveDelegators pasvDlg
+    let actCapital = pab ^. totalActiveCapital . tacAmount
+    let expectTotalActiveCapital = sum (initialStake <$> [0, 3, 6, 9, 12]) + sum (reducedStake <$> [1, 4, 7, 10, 13])
+    liftIO $ assertEqual "Total active capital" expectTotalActiveCapital actCapital
+
+assertAccountsCorrect :: forall m. (SupportsPersistentAccount 'P7 m, MonadFail m) => Accounts 'P7 -> m ()
+assertAccountsCorrect accounts = do
+    accountExpect 0 (dummyBakerStake initialStake 0 NoChange) Nothing
+    accountExpect 1 (dummyBakerStake reducedStake 1 NoChange) (prePreExpect (cooldownReduce 1))
+    accountExpect 2 AccountStakeNone (prePreExpect (initialStake 2))
+    accountExpect 3 (dummyDelegatorStake initialStake 3 (DelegateToBaker 0) NoChange) Nothing
+    accountExpect 4 (dummyDelegatorStake reducedStake 4 (DelegateToBaker 0) NoChange) (prePreExpect (cooldownReduce 4))
+    accountExpect 5 AccountStakeNone (prePreExpect (initialStake 5))
+    accountExpect 6 (dummyDelegatorStake initialStake 6 (DelegateToBaker 1) NoChange) Nothing
+    accountExpect 7 (dummyDelegatorStake reducedStake 7 (DelegateToBaker 1) NoChange) (prePreExpect (cooldownReduce 7))
+    accountExpect 8 AccountStakeNone (prePreExpect (initialStake 8))
+    accountExpect 9 (dummyDelegatorStake initialStake 9 DelegatePassive NoChange) Nothing
+    accountExpect 10 (dummyDelegatorStake reducedStake 10 DelegatePassive NoChange) (prePreExpect (cooldownReduce 10))
+    accountExpect 11 AccountStakeNone (prePreExpect (initialStake 11))
+    accountExpect 12 (dummyDelegatorStake initialStake 12 DelegatePassive NoChange) Nothing
+    accountExpect 13 (dummyDelegatorStake reducedStake 13 DelegatePassive NoChange) (prePreExpect (cooldownReduce 13))
+    accountExpect 14 AccountStakeNone (prePreExpect (initialStake 14))
+  where
+    availableExpect accIndex = 1_000_000_000_000_000 - initialStake accIndex
+    cooldownReduce accIndex = initialStake accIndex - reducedStake accIndex
+    prePreExpect amt =
+        Just
+            ( Cooldowns
+                { inCooldown = Map.empty,
+                  preCooldown = Absent,
+                  prePreCooldown = Present amt
+                }
+            )
+    accountExpect accIndex expectStake expectCooldowns = do
+        (Just a) <- indexedAccount accIndex accounts
+        liftIO . assertEqual ("Account " ++ show accIndex ++ " stake") expectStake
+            =<< accountStake a
+        liftIO . assertEqual ("Account " ++ show accIndex ++ " cooldowns") expectCooldowns
+            =<< accountCooldowns a
+        liftIO . assertEqual ("Account " ++ show accIndex ++ " available amount") (availableExpect accIndex)
+            =<< accountAvailableAmount a
+
+tests :: Spec
+tests = describe "GlobalStateTests.AccountsMigrationP6ToP7"
+    $ around
+        ( \kont ->
+            withTempDirectory "." "blockstate" $ \dir ->
+                bracket
+                    ( do
+                        c0 <- createPBSC dir "0"
+                        c1 <- createPBSC dir "1"
+                        return (c0, c1)
+                    )
+                    ( \(c0, c1) -> do
+                        destroyPBSC c0
+                        destroyPBSC c1
+                    )
+                    kont
+        )
+    $ do
+        it "migration" (uncurry migrationTest)
+  where
+    createPBSC dir i = do
+        pbscBlobStore <- createBlobStore (dir </> ("blockstate" ++ i ++ ".dat"))
+        pbscAccountCache <- newAccountCache 100
+        pbscModuleCache <- M.newModuleCache 100
+        pbscAccountMap <- LMDBAccountMap.openDatabase (dir </> ("accountmap" ++ i))
+        return PersistentBlockStateContext{..}
+    destroyPBSC PersistentBlockStateContext{..} = do
+        closeBlobStore pbscBlobStore
+        LMDBAccountMap.closeDatabase pbscAccountMap
diff --git a/concordium-consensus/tests/globalstate/GlobalStateTests/EnduringDataFlags.hs b/concordium-consensus/tests/globalstate/GlobalStateTests/EnduringDataFlags.hs
index 67522a12d..f5644c2d8 100644
--- a/concordium-consensus/tests/globalstate/GlobalStateTests/EnduringDataFlags.hs
+++ b/concordium-consensus/tests/globalstate/GlobalStateTests/EnduringDataFlags.hs
@@ -13,7 +13,7 @@ genPendingChangeFlags = elements [PendingChangeNone, PendingChangeReduce, Pendin
 genStakeFlags :: Gen StakeFlags
 genStakeFlags =
     oneof
-        [ pure StakeFlagsNone,
+        [ StakeFlagsNone <$> arbitrary,
           StakeFlagsBaker <$> arbitrary <*> genPendingChangeFlags,
           StakeFlagsDelegator <$> arbitrary <*> arbitrary <*> genPendingChangeFlags
         ]
diff --git a/concordium-consensus/tests/globalstate/Spec.hs b/concordium-consensus/tests/globalstate/Spec.hs
index 9b83df621..ba5abbd1f 100644
--- a/concordium-consensus/tests/globalstate/Spec.hs
+++ b/concordium-consensus/tests/globalstate/Spec.hs
@@ -6,6 +6,7 @@ import qualified GlobalStateTests.AccountMap (tests)
 import qualified GlobalStateTests.AccountReleaseScheduleMigration (tests)
 import qualified GlobalStateTests.AccountReleaseScheduleTest (tests)
 import qualified GlobalStateTests.Accounts (tests)
+import qualified GlobalStateTests.AccountsMigrationP6ToP7 (tests)
 import qualified GlobalStateTests.BlobStore (tests)
 import qualified GlobalStateTests.BlockHash (tests)
 import qualified GlobalStateTests.Cache (tests)
@@ -51,3 +52,4 @@ main = atLevel $ \lvl -> hspec $ do
     GlobalStateTests.UpdateQueues.tests
     GlobalStateTests.LMDBAccountMap.tests
     GlobalStateTests.DifferenceMap.tests
+    GlobalStateTests.AccountsMigrationP6ToP7.tests

From d8f5ce6407e15f894d7539fd2451c0613d452863 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Mon, 27 May 2024 17:32:02 +0200
Subject: [PATCH 12/81] Changes to GetBakerPoolStatus GRPC.

---
 CHANGELOG.md                                  |   1 +
 concordium-base                               |   2 +-
 .../src-lib/Concordium/External/GRPC2.hs      |   8 +-
 .../src/Concordium/GlobalState/BlockState.hs  |  18 ++-
 .../GlobalState/Persistent/BlockState.hs      | 127 ++++++++++--------
 .../src/Concordium/Queries.hs                 |  46 ++++---
 6 files changed, 120 insertions(+), 82 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 89f1fcdd4..4ccf8cacc 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -2,6 +2,7 @@
 
 ## Unreleased changes
 
+- Fix a bug where `GetBakersRewardPeriod` returns incorrect data (#1176).
 - Add support for new `invoke` calls from smart contracts in protocol version 7:
   - query the contract module reference for a given contract address
   - query the contract name for a given contract address
diff --git a/concordium-base b/concordium-base
index 567616074..1f84cafad 160000
--- a/concordium-base
+++ b/concordium-base
@@ -1 +1 @@
-Subproject commit 567616074177297ea8533693c8ec8f1397afb564
+Subproject commit 1f84cafad799c7b4b677f2cabc82968c3db1b06a
diff --git a/concordium-consensus/src-lib/Concordium/External/GRPC2.hs b/concordium-consensus/src-lib/Concordium/External/GRPC2.hs
index 93005b298..0a63f2f8a 100644
--- a/concordium-consensus/src-lib/Concordium/External/GRPC2.hs
+++ b/concordium-consensus/src-lib/Concordium/External/GRPC2.hs
@@ -548,10 +548,10 @@ getPoolInfoV2 cptr blockType blockHashPtr bakerId outHash outVec copierCbk = do
     Ext.ConsensusRunner mvr <- deRefStablePtr cptr
     let copier = callCopyToVecCallback copierCbk
     bhi <- decodeBlockHashInput blockType blockHashPtr
-    response <- runMVR (Q.getPoolStatus bhi (Just $ fromIntegral bakerId)) mvr
+    response <- runMVR (Q.getPoolStatus bhi (fromIntegral bakerId)) mvr
     copyHashTo outHash response
     case fmap toProto <$> response of
-        Q.BQRBlock _ (Just (Left proto)) -> do
+        Q.BQRBlock _ (Just proto) -> do
             let encoded = Proto.encodeMessage proto
             BS.unsafeUseAsCStringLen encoded (\(ptr, len) -> copier outVec (castPtr ptr) (fromIntegral len))
             return $ queryResultCode QRSuccess
@@ -573,10 +573,10 @@ getPassiveDelegationInfoV2 cptr blockType blockHashPtr outHash outVec copierCbk
     Ext.ConsensusRunner mvr <- deRefStablePtr cptr
     let copier = callCopyToVecCallback copierCbk
     bhi <- decodeBlockHashInput blockType blockHashPtr
-    response <- runMVR (Q.getPoolStatus bhi Nothing) mvr
+    response <- runMVR (Q.getPassiveDelegationStatus bhi) mvr
     copyHashTo outHash response
     case fmap toProto <$> response of
-        Q.BQRBlock _ (Just (Right proto)) -> do
+        Q.BQRBlock _ (Just proto) -> do
             let encoded = Proto.encodeMessage proto
             BS.unsafeUseAsCStringLen encoded (\(ptr, len) -> copier outVec (castPtr ptr) (fromIntegral len))
             return $ queryResultCode QRSuccess
diff --git a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs
index 4b38ca325..bb94900bd 100644
--- a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs
@@ -81,7 +81,7 @@ import Concordium.Types.Accounts
 import Concordium.Types.Accounts.Releases
 import Concordium.Types.AnonymityRevokers
 import Concordium.Types.IdentityProviders
-import Concordium.Types.Queries (PoolStatus, RewardStatus')
+import Concordium.Types.Queries (BakerPoolStatus, PassiveDelegationStatus, RewardStatus')
 import Concordium.Types.SeedState (SeedState, SeedStateVersion (..), SeedStateVersionFor)
 import Concordium.Types.Transactions hiding (BareBlockItem (..))
 import qualified Concordium.Types.UpdateQueues as UQ
@@ -641,14 +641,19 @@ class (ContractStateOperations m, AccountOperations m, ModuleQuery m) => BlockSt
     -- | Get the epoch time of the next scheduled payday.
     getPaydayEpoch :: (PVSupportsDelegation (MPV m)) => BlockState m -> m Epoch
 
-    -- | Get a 'PoolStatus' record describing the status of a baker pool (when the 'BakerId' is
-    --  provided) or the passive delegators (when 'Nothing' is provided). The result is 'Nothing'
-    --  if the 'BakerId' is not currently a baker.
+    -- | Get a 'BakerPoolStatus' record describing the status of a baker pool. The result is
+    -- 'Nothing' if the 'BakerId' is not an active or current-epoch baker.
     getPoolStatus ::
         (PVSupportsDelegation (MPV m)) =>
         BlockState m ->
-        Maybe BakerId ->
-        m (Maybe PoolStatus)
+        BakerId ->
+        m (Maybe BakerPoolStatus)
+
+    -- | Get the status of passive delegation.
+    getPassiveDelegationStatus ::
+        (PVSupportsDelegation (MPV m)) =>
+        BlockState m ->
+        m PassiveDelegationStatus
 
 -- | Distribution of newly-minted GTU.
 data MintAmounts = MintAmounts
@@ -1497,6 +1502,7 @@ instance (Monad (t m), MonadTrans t, BlockStateQuery m) => BlockStateQuery (MGST
     getChainParameters = lift . getChainParameters
     getPaydayEpoch = lift . getPaydayEpoch
     getPoolStatus s = lift . getPoolStatus s
+    getPassiveDelegationStatus = lift . getPassiveDelegationStatus
     {-# INLINE getModule #-}
     {-# INLINE getAccount #-}
     {-# INLINE accountExists #-}
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
index ac682a7bd..6e7d759cc 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
@@ -82,7 +82,13 @@ import Concordium.Types.Execution (DelegationTarget (..), TransactionIndex, Tran
 import qualified Concordium.Types.Execution as Transactions
 import Concordium.Types.HashableTo
 import qualified Concordium.Types.IdentityProviders as IPS
-import Concordium.Types.Queries (CurrentPaydayBakerPoolStatus (..), PoolStatus (..), RewardStatus' (..), makePoolPendingChange)
+import Concordium.Types.Queries (
+    BakerPoolStatus (..),
+    CurrentPaydayBakerPoolStatus (..),
+    PassiveDelegationStatus (..),
+    RewardStatus' (..),
+    makePoolPendingChange,
+ )
 import Concordium.Types.SeedState
 import qualified Concordium.Types.TransactionOutcomes as TransactionOutcomes
 import qualified Concordium.Types.Transactions as Transactions
@@ -2705,6 +2711,22 @@ doSetPaydayMintRate pbs r = do
             hpr' <- refMake pr{nextPaydayMintRate = r}
             storePBS pbs bsp{bspRewardDetails = BlockRewardDetailsV1 hpr'}
 
+doGetPassiveDelegationStatus ::
+    forall pv m.
+    (IsProtocolVersion pv, SupportsPersistentState pv m, PVSupportsDelegation pv) =>
+    PersistentBlockState pv ->
+    m PassiveDelegationStatus
+doGetPassiveDelegationStatus pbs = case delegationChainParameters @pv of
+    DelegationChainParameters -> do
+        bsp <- loadPBS pbs
+        pdsDelegatedCapital <- passiveDelegationCapital bsp
+        pdsCommissionRates <- _ppPassiveCommissions . _cpPoolParameters <$> lookupCurrentParameters (bspUpdates bsp)
+        poolRewards <- refLoad (bspPoolRewards bsp)
+        let pdsCurrentPaydayTransactionFeesEarned = passiveDelegationTransactionRewards poolRewards
+        pdsCurrentPaydayDelegatedCapital <- currentPassiveDelegationCapital poolRewards
+        pdsAllPoolTotalCapital <- totalCapital bsp
+        return $! PassiveDelegationStatus{..}
+
 doGetPoolStatus ::
     forall pv m.
     ( IsProtocolVersion pv,
@@ -2712,66 +2734,58 @@ doGetPoolStatus ::
       PVSupportsDelegation pv
     ) =>
     PersistentBlockState pv ->
-    Maybe BakerId ->
-    m (Maybe PoolStatus)
-doGetPoolStatus pbs Nothing = case delegationChainParameters @pv of
-    DelegationChainParameters -> do
-        bsp <- loadPBS pbs
-        psDelegatedCapital <- passiveDelegationCapital bsp
-        psCommissionRates <- _ppPassiveCommissions . _cpPoolParameters <$> lookupCurrentParameters (bspUpdates bsp)
-        poolRewards <- refLoad (bspPoolRewards bsp)
-        let psCurrentPaydayTransactionFeesEarned = passiveDelegationTransactionRewards poolRewards
-        psCurrentPaydayDelegatedCapital <- currentPassiveDelegationCapital poolRewards
-        psAllPoolTotalCapital <- totalCapital bsp
-        return $ Just PassiveDelegationStatus{..}
-doGetPoolStatus pbs (Just psBakerId@(BakerId aid)) = case delegationChainParameters @pv of
+    BakerId ->
+    m (Maybe BakerPoolStatus)
+doGetPoolStatus pbs psBakerId@(BakerId aid) = case delegationChainParameters @pv of
     DelegationChainParameters -> do
         bsp <- loadPBS pbs
         Accounts.indexedAccount aid (bspAccounts bsp) >>= \case
             Nothing -> return Nothing
-            Just acct ->
-                accountBaker acct >>= \case
+            Just acct -> do
+                psBakerAddress <- accountCanonicalAddress acct
+                psAllPoolTotalCapital <- totalCapital bsp
+                mBaker <- accountBaker acct
+                psActiveStatus <- forM mBaker $ \baker -> do
+                    let abpsBakerEquityCapital = baker ^. BaseAccounts.stakedAmount
+                    abpsDelegatedCapital <- poolDelegatorCapital bsp psBakerId
+                    poolParameters <- _cpPoolParameters <$> lookupCurrentParameters (bspUpdates bsp)
+                    let abpsDelegatedCapitalCap =
+                            delegatedCapitalCap
+                                poolParameters
+                                psAllPoolTotalCapital
+                                psBakerEquityCapital
+                                psDelegatedCapital
+                    let abpsPoolInfo = baker ^. BaseAccounts.bakerPoolInfo
+                    let abpsBakerStakePendingChange =
+                            makePoolPendingChange $ BaseAccounts.pendingChangeEffectiveTimestamp <$> (baker ^. BaseAccounts.bakerPendingChange)
+                    return $! ActiveBakerPoolStatus{..}
+                epochBakers <- refLoad (_birkCurrentEpochBakers $ bspBirkParameters bsp)
+                mepochBaker <- epochBaker psBakerId epochBakers
+                psCurrentPaydayStatus <- case mepochBaker of
                     Nothing -> return Nothing
-                    Just baker -> do
-                        let psBakerEquityCapital = baker ^. BaseAccounts.stakedAmount
-                        psDelegatedCapital <- poolDelegatorCapital bsp psBakerId
-                        poolParameters <- _cpPoolParameters <$> lookupCurrentParameters (bspUpdates bsp)
-                        psAllPoolTotalCapital <- totalCapital bsp
-                        let psDelegatedCapitalCap =
-                                delegatedCapitalCap
-                                    poolParameters
-                                    psAllPoolTotalCapital
-                                    psBakerEquityCapital
-                                    psDelegatedCapital
-                        psBakerAddress <- accountCanonicalAddress acct
-                        let psPoolInfo = baker ^. BaseAccounts.bakerPoolInfo
-                        let psBakerStakePendingChange =
-                                makePoolPendingChange $ BaseAccounts.pendingChangeEffectiveTimestamp <$> (baker ^. BaseAccounts.bakerPendingChange)
-                        epochBakers <- refLoad (_birkCurrentEpochBakers $ bspBirkParameters bsp)
-                        mepochBaker <- epochBaker psBakerId epochBakers
-                        psCurrentPaydayStatus <- case mepochBaker of
-                            Nothing -> return Nothing
-                            Just (_, effectiveStake) -> do
-                                poolRewards <- refLoad (bspPoolRewards bsp)
-                                mbcr <- lookupBakerCapitalAndRewardDetails psBakerId poolRewards
-                                case mbcr of
-                                    Nothing -> return Nothing -- This should not happen
-                                    Just (bc, BakerPoolRewardDetails{..}) -> do
-                                        return $
-                                            Just
-                                                CurrentPaydayBakerPoolStatus
-                                                    { bpsBlocksBaked = blockCount,
-                                                      bpsFinalizationLive = finalizationAwake,
-                                                      bpsTransactionFeesEarned = transactionFeesAccrued,
-                                                      bpsEffectiveStake = effectiveStake,
-                                                      bpsLotteryPower =
-                                                        fromIntegral effectiveStake
-                                                            / fromIntegral (_bakerTotalStake epochBakers),
-                                                      bpsBakerEquityCapital = bcBakerEquityCapital bc,
-                                                      bpsDelegatedCapital = bcTotalDelegatorCapital bc,
-                                                      bpsCommissionRates = psPoolInfo ^. BaseAccounts.poolCommissionRates
-                                                    }
-                        return $ Just BakerPoolStatus{..}
+                    Just (_, effectiveStake) -> do
+                        poolRewards <- refLoad (bspPoolRewards bsp)
+                        mbcr <- lookupBakerCapitalAndRewardDetails psBakerId poolRewards
+                        case mbcr of
+                            Nothing -> return Nothing -- This should not happen
+                            Just (bc, BakerPoolRewardDetails{..}) -> do
+                                return $
+                                    Just
+                                        CurrentPaydayBakerPoolStatus
+                                            { bpsBlocksBaked = blockCount,
+                                              bpsFinalizationLive = finalizationAwake,
+                                              bpsTransactionFeesEarned = transactionFeesAccrued,
+                                              bpsEffectiveStake = effectiveStake,
+                                              bpsLotteryPower =
+                                                fromIntegral effectiveStake
+                                                    / fromIntegral (_bakerTotalStake epochBakers),
+                                              bpsBakerEquityCapital = bcBakerEquityCapital bc,
+                                              bpsDelegatedCapital = bcTotalDelegatorCapital bc,
+                                              bpsCommissionRates = psPoolInfo ^. BaseAccounts.poolCommissionRates
+                                            }
+                if isJust psActiveStatus || isJust psCurrentPaydayStatus
+                    then return $ Just BakerPoolStatus{..}
+                    else return Nothing
 
 doGetTransactionOutcome :: forall pv m. (SupportsPersistentState pv m) => PersistentBlockState pv -> Transactions.TransactionIndex -> m (Maybe TransactionSummary)
 doGetTransactionOutcome pbs transHash = do
@@ -3542,6 +3556,7 @@ instance (IsProtocolVersion pv, PersistentState av pv r m) => BlockStateQuery (P
     getChainParameters = doGetChainParameters . hpbsPointers
     getPaydayEpoch = doGetPaydayEpoch . hpbsPointers
     getPoolStatus = doGetPoolStatus . hpbsPointers
+    getPassiveDelegationStatus = doGetPassiveDelegationStatus . hpbsPointers
 
 instance (MonadIO m, PersistentState av pv r m) => ContractStateOperations (PersistentBlockStateMonad pv r m) where
     thawContractState (Instances.InstanceStateV0 inst) = return inst
diff --git a/concordium-consensus/src/Concordium/Queries.hs b/concordium-consensus/src/Concordium/Queries.hs
index 00225fa67..6fb06602b 100644
--- a/concordium-consensus/src/Concordium/Queries.hs
+++ b/concordium-consensus/src/Concordium/Queries.hs
@@ -1125,7 +1125,7 @@ getModuleSource bhi modRef = do
         bhi
 
 -- | Get the status of a particular delegation pool.
-getPoolStatus :: forall finconf. BlockHashInput -> Maybe BakerId -> MVR finconf (BHIQueryResponse (Maybe PoolStatus))
+getPoolStatus :: forall finconf. BlockHashInput -> BakerId -> MVR finconf (BHIQueryResponse (Maybe BakerPoolStatus))
 getPoolStatus blockHashInput mbid = do
     liftSkovQueryStateBHI poolStatus blockHashInput
   where
@@ -1133,11 +1133,25 @@ getPoolStatus blockHashInput mbid = do
         forall m.
         (BS.BlockStateQuery m, MonadProtocolVersion m) =>
         BlockState m ->
-        m (Maybe PoolStatus)
+        m (Maybe BakerPoolStatus)
     poolStatus bs = case delegationSupport @(AccountVersionFor (MPV m)) of
         SAVDelegationNotSupported -> return Nothing
         SAVDelegationSupported -> BS.getPoolStatus bs mbid
 
+-- | Get the status of passive delegation.
+getPassiveDelegationStatus :: forall finconf. BlockHashInput -> MVR finconf (BHIQueryResponse (Maybe PassiveDelegationStatus))
+getPassiveDelegationStatus blockHashInput = do
+    liftSkovQueryStateBHI poolStatus blockHashInput
+  where
+    poolStatus ::
+        forall m.
+        (BS.BlockStateQuery m, MonadProtocolVersion m) =>
+        BlockState m ->
+        m (Maybe PassiveDelegationStatus)
+    poolStatus bs = case delegationSupport @(AccountVersionFor (MPV m)) of
+        SAVDelegationNotSupported -> return Nothing
+        SAVDelegationSupported -> Just <$> BS.getPassiveDelegationStatus bs
+
 -- | Get a list of all registered baker IDs in the specified block.
 getRegisteredBakers :: forall finconf. BlockHashInput -> MVR finconf (BHIQueryResponse [BakerId])
 getRegisteredBakers = liftSkovQueryStateBHI BS.getActiveBakers
@@ -1679,7 +1693,7 @@ getBakersRewardPeriod = liftSkovQueryBHI bakerRewardPeriodInfosV0 bakerRewardPer
         finCommitteeParams <- BS.getCurrentEpochFinalizationCommitteeParameters bs
         let finalizationCommittee = ConsensusV1.computeFinalizationCommittee bakers finCommitteeParams
         mapBakersToInfos bs (Vec.toList $ fullBakerInfos bakers) (SkovV1.finalizerBakerId <$> Vec.toList (SkovV1.committeeFinalizers finalizationCommittee))
-    -- Map bakers to their assoicated 'BakerRewardPeriodInfo'.
+    -- Map bakers to their associated 'BakerRewardPeriodInfo'.
     -- The supplied bakers and list of baker ids (of the finalization committee) MUST
     -- be sorted in ascending order of their baker id.
     -- Returns a list of BakerRewardPeriodInfo's in ascending order of the baker id.
@@ -1720,19 +1734,21 @@ getBakersRewardPeriod = liftSkovQueryBHI bakerRewardPeriodInfosV0 bakerRewardPer
         m BakerRewardPeriodInfo
     toBakerRewardPeriodInfo isFinalizer bs FullBakerInfo{..} = do
         let bakerId = _bakerIdentity _theBakerInfo
-        BS.getPoolStatus bs (Just bakerId) >>= \case
+        BS.getPoolStatus bs bakerId >>= \case
             Nothing -> error "A pool for a known baker could not be looked up."
-            Just PassiveDelegationStatus{} -> error "A passive delegation status was returned when querying with a bakerid."
-            Just BakerPoolStatus{..} -> do
-                return
-                    BakerRewardPeriodInfo
-                        { brpiBaker = _theBakerInfo,
-                          brpiEffectiveStake = _bakerStake,
-                          brpiCommissionRates = psPoolInfo ^. poolCommissionRates,
-                          brpiEquityCapital = psBakerEquityCapital,
-                          brpiDelegatedCapital = psDelegatedCapital,
-                          brpiIsFinalizer = isFinalizer
-                        }
+            Just bps
+                | Just CurrentPaydayBakerPoolStatus{..} <- psCurrentPaydayStatus bps -> do
+                    return
+                        BakerRewardPeriodInfo
+                            { brpiBaker = _theBakerInfo,
+                              brpiEffectiveStake = _bakerStake,
+                              brpiCommissionRates = bpsCommissionRates,
+                              brpiEquityCapital = bpsBakerEquityCapital,
+                              brpiDelegatedCapital = bpsDelegatedCapital,
+                              brpiIsFinalizer = isFinalizer
+                            }
+                | otherwise ->
+                    error "The current payday status for a known baker could not be looked up."
 
 -- | Get the earliest time at which a baker is projected to win the lottery.
 --  Returns 'Nothing' for consensus version 0.

From fdcaf7019ec934f4bdd91bc9d9fe8c7c8677d99a Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Tue, 28 May 2024 16:11:53 +0200
Subject: [PATCH 13/81] Fix handling of GetPoolInfo.

---
 CHANGELOG.md                                         |  1 +
 concordium-base                                      |  2 +-
 .../src/Concordium/GlobalState/Persistent/Bakers.hs  |  9 +++++++--
 .../Concordium/GlobalState/Persistent/BlockState.hs  | 12 ++++++++----
 4 files changed, 17 insertions(+), 7 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 4ccf8cacc..a73f80eb8 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -3,6 +3,7 @@
 ## Unreleased changes
 
 - Fix a bug where `GetBakersRewardPeriod` returns incorrect data (#1176).
+- Fix a bug where `GetPoolInfo` returns incorrect data (#1177).
 - Add support for new `invoke` calls from smart contracts in protocol version 7:
   - query the contract module reference for a given contract address
   - query the contract name for a given contract address
diff --git a/concordium-base b/concordium-base
index 1f84cafad..df3f9f5b0 160000
--- a/concordium-base
+++ b/concordium-base
@@ -1 +1 @@
-Subproject commit 1f84cafad799c7b4b677f2cabc82968c3db1b06a
+Subproject commit df3f9f5b08b0d80f3c6aeec7e75bcc3d1c69bdee
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Bakers.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Bakers.hs
index f1e9ce40f..1bebe55cd 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Bakers.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Bakers.hs
@@ -162,10 +162,15 @@ migratePersistentEpochBakers migration PersistentEpochBakers{..} = do
             }
 
 -- | Look up a baker and its stake in a 'PersistentEpochBakers'.
-epochBaker :: forall m pv. (IsProtocolVersion pv, MonadBlobStore m) => BakerId -> PersistentEpochBakers pv -> m (Maybe (BaseAccounts.BakerInfo, Amount))
+epochBaker ::
+    forall m pv.
+    (IsProtocolVersion pv, MonadBlobStore m) =>
+    BakerId ->
+    PersistentEpochBakers pv ->
+    m (Maybe (BaseAccounts.BakerInfoEx (AccountVersionFor pv), Amount))
 epochBaker bid PersistentEpochBakers{..} = do
     (BakerInfos infoVec) <- refLoad _bakerInfos
-    minfo <- binarySearchIM loadBakerInfo BaseAccounts._bakerIdentity infoVec bid
+    minfo <- binarySearchIM loadPersistentBakerInfoRef (^. BaseAccounts.bakerIdentity) infoVec bid
     forM minfo $ \(idx, binfo) -> do
         (BakerStakes stakeVec) <- refLoad _bakerStakes
         return (binfo, stakeVec Vec.! idx)
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
index 6e7d759cc..593345223 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
@@ -83,6 +83,7 @@ import qualified Concordium.Types.Execution as Transactions
 import Concordium.Types.HashableTo
 import qualified Concordium.Types.IdentityProviders as IPS
 import Concordium.Types.Queries (
+    ActiveBakerPoolStatus (..),
     BakerPoolStatus (..),
     CurrentPaydayBakerPoolStatus (..),
     PassiveDelegationStatus (..),
@@ -2753,8 +2754,8 @@ doGetPoolStatus pbs psBakerId@(BakerId aid) = case delegationChainParameters @pv
                             delegatedCapitalCap
                                 poolParameters
                                 psAllPoolTotalCapital
-                                psBakerEquityCapital
-                                psDelegatedCapital
+                                abpsBakerEquityCapital
+                                abpsDelegatedCapital
                     let abpsPoolInfo = baker ^. BaseAccounts.bakerPoolInfo
                     let abpsBakerStakePendingChange =
                             makePoolPendingChange $ BaseAccounts.pendingChangeEffectiveTimestamp <$> (baker ^. BaseAccounts.bakerPendingChange)
@@ -2763,7 +2764,7 @@ doGetPoolStatus pbs psBakerId@(BakerId aid) = case delegationChainParameters @pv
                 mepochBaker <- epochBaker psBakerId epochBakers
                 psCurrentPaydayStatus <- case mepochBaker of
                     Nothing -> return Nothing
-                    Just (_, effectiveStake) -> do
+                    Just (currentEpochBaker, effectiveStake) -> do
                         poolRewards <- refLoad (bspPoolRewards bsp)
                         mbcr <- lookupBakerCapitalAndRewardDetails psBakerId poolRewards
                         case mbcr of
@@ -2781,7 +2782,10 @@ doGetPoolStatus pbs psBakerId@(BakerId aid) = case delegationChainParameters @pv
                                                     / fromIntegral (_bakerTotalStake epochBakers),
                                               bpsBakerEquityCapital = bcBakerEquityCapital bc,
                                               bpsDelegatedCapital = bcTotalDelegatorCapital bc,
-                                              bpsCommissionRates = psPoolInfo ^. BaseAccounts.poolCommissionRates
+                                              bpsCommissionRates =
+                                                currentEpochBaker
+                                                    ^. BaseAccounts.bieBakerPoolInfo
+                                                        . BaseAccounts.poolCommissionRates
                                             }
                 if isJust psActiveStatus || isJust psCurrentPaydayStatus
                     then return $ Just BakerPoolStatus{..}

From fcf2bf2ba3d06e49dfb43933f2c002a59a4eb6d4 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Tue, 4 Jun 2024 14:40:55 +0200
Subject: [PATCH 14/81] Support cooldown and available balance in account info
 query.

---
 concordium-base                               |  2 +-
 .../src/Concordium/GlobalState/BlockState.hs  | 10 +++++
 .../Concordium/GlobalState/CooldownQueue.hs   | 44 +++++++++++++++++++
 .../GlobalState/Persistent/BlockState.hs      |  2 +
 .../src/Concordium/Queries.hs                 | 37 ++++++++++++++--
 5 files changed, 91 insertions(+), 4 deletions(-)

diff --git a/concordium-base b/concordium-base
index df3f9f5b0..be94be822 160000
--- a/concordium-base
+++ b/concordium-base
@@ -1 +1 @@
-Subproject commit df3f9f5b08b0d80f3c6aeec7e75bcc3d1c69bdee
+Subproject commit be94be822015d5f4bb16a08a182e1e013a2b4b16
diff --git a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs
index bb94900bd..65eb99ca9 100644
--- a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs
@@ -89,6 +89,7 @@ import qualified Concordium.Types.UpdateQueues as UQ
 import Concordium.Crypto.EncryptedTransfers
 import Concordium.GlobalState.ContractStateFFIHelpers (LoadCallback)
 import qualified Concordium.GlobalState.ContractStateV1 as StateV1
+import Concordium.GlobalState.CooldownQueue (Cooldowns)
 import Concordium.GlobalState.Persistent.LMDB (FixedSizeSerialization)
 import Concordium.GlobalState.TransactionTable (TransactionTable)
 import Concordium.ID.Parameters (GlobalContext)
@@ -245,6 +246,13 @@ class (BlockStateTypes m, Monad m) => AccountOperations m where
     --  Note: this may not be implemented efficiently, and is principally intended for testing purposes.
     getAccountHash :: Account m -> m (AccountHash (AccountVersionFor (MPV m)))
 
+    -- | Get the 'Cooldowns' for an account, if any. This is only available at account versions that
+    -- support flexible cooldowns.
+    getAccountCooldowns ::
+        (SupportsFlexibleCooldown (AccountVersionFor (MPV m)) ~ True) =>
+        Account m ->
+        m (Maybe Cooldowns)
+
 -- * Active, current and next bakers/delegators
 
 --
@@ -1557,6 +1565,7 @@ instance (Monad (t m), MonadTrans t, AccountOperations m) => AccountOperations (
     getAccountBakerInfoRef = lift . getAccountBakerInfoRef
     derefBakerInfo = lift . derefBakerInfo
     getAccountHash = lift . getAccountHash
+    getAccountCooldowns = lift . getAccountCooldowns
     {-# INLINE getAccountCanonicalAddress #-}
     {-# INLINE getAccountAmount #-}
     {-# INLINE getAccountAvailableAmount #-}
@@ -1571,6 +1580,7 @@ instance (Monad (t m), MonadTrans t, AccountOperations m) => AccountOperations (
     {-# INLINE getAccountBakerInfoRef #-}
     {-# INLINE derefBakerInfo #-}
     {-# INLINE getAccountHash #-}
+    {-# INLINE getAccountCooldowns #-}
 
 instance (Monad (t m), MonadTrans t, ContractStateOperations m) => ContractStateOperations (MGSTrans t m) where
     thawContractState = lift . thawContractState
diff --git a/concordium-consensus/src/Concordium/GlobalState/CooldownQueue.hs b/concordium-consensus/src/Concordium/GlobalState/CooldownQueue.hs
index 368350e13..752ad022e 100644
--- a/concordium-consensus/src/Concordium/GlobalState/CooldownQueue.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/CooldownQueue.hs
@@ -13,11 +13,13 @@ import Data.Serialize
 
 import qualified Concordium.Crypto.SHA256 as Hash
 import Concordium.Types
+import Concordium.Types.Accounts (Cooldown (..), CooldownStatus (..))
 import Concordium.Types.HashableTo
 import Concordium.Utils.Serialization
 
 import Concordium.GlobalState.Persistent.BlobStore
 import Concordium.Types.Option
+import Data.Foldable
 
 -- | The amounts that are currently in cooldown and any pre-cooldown and pre-pre-cooldown target
 -- balances.
@@ -92,3 +94,45 @@ cooldownTotal Cooldowns{..} =
 -- FIXME: Decide if we want to use the serialization for hashing.
 instance HashableTo Hash.Hash Cooldowns where
     getHash = getHash . encode
+
+data CooldownCalculationParameters = CooldownCalculationParameters
+    { ccpEpochDuration :: Duration,
+      ccpCurrentEpoch :: Epoch,
+      ccpTriggerTime :: Timestamp,
+      ccpNextPayday :: Epoch,
+      ccpRewardPeriodLength :: RewardPeriodLength,
+      ccpCooldownDuration :: DurationSeconds
+    }
+
+-- | Calculate the timestamp at which stake in pre-cooldown is expected to be released from
+--  cooldown. This is computed by adding the cooldown duration to the time of the next payday,
+--  where the time of the next payday is the time of the next epoch transition (i.e trigger
+--  block time) plus the duration of an epoch for each epoch between the current epoch and the
+--  payday.
+preCooldownTimestamp :: CooldownCalculationParameters -> Timestamp
+preCooldownTimestamp CooldownCalculationParameters{..} =
+    ccpTriggerTime
+        `addDuration` (fromIntegral (ccpNextPayday - ccpCurrentEpoch - 1) * ccpEpochDuration)
+        `addDurationSeconds` ccpCooldownDuration
+
+-- | Calculate the timestamp at which stake in pre-pre-cooldown is expected to be released from
+--  cooldown. If the next epoch is the next payday, this is the time of the payday after that.
+--  Otherwise, this is the same as the 'preCooldownTimestamp'.
+prePreCooldownTimestamp :: CooldownCalculationParameters -> Timestamp
+prePreCooldownTimestamp ccp@CooldownCalculationParameters{..}
+    | ccpNextPayday - ccpCurrentEpoch == 1 =
+        ccpTriggerTime
+            `addDuration` (ccpEpochDuration * fromIntegral ccpRewardPeriodLength)
+            `addDurationSeconds` ccpCooldownDuration
+    | otherwise = preCooldownTimestamp ccp
+
+-- | Convert a 'Cooldowns' to a list of 'Cooldown's.
+toCooldownList :: CooldownCalculationParameters -> Cooldowns -> [Cooldown]
+toCooldownList ccp Cooldowns{..} = cooldowns ++ preCooldowns ++ prePreCooldowns
+  where
+    cooldowns = (\(ts, amt) -> Cooldown ts amt StatusCooldown) <$> Map.toAscList inCooldown
+    preCooldowns =
+        (\amt -> Cooldown (preCooldownTimestamp ccp) amt StatusPreCooldown) <$> toList preCooldown
+    prePreCooldowns =
+        (\amt -> Cooldown (prePreCooldownTimestamp ccp) amt StatusPrePreCooldown)
+            <$> toList prePreCooldown
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
index 593345223..c65202ce7 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
@@ -3613,6 +3613,8 @@ instance (PersistentState av pv r m, IsProtocolVersion pv) => AccountOperations
 
     getAccountHash = accountHash
 
+    getAccountCooldowns = accountCooldowns
+
 instance (IsProtocolVersion pv, PersistentState av pv r m) => BlockStateOperations (PersistentBlockStateMonad pv r m) where
     bsoGetModule pbs mref = doGetModule pbs mref
     bsoGetAccount bs = doGetAccount bs
diff --git a/concordium-consensus/src/Concordium/Queries.hs b/concordium-consensus/src/Concordium/Queries.hs
index 6fb06602b..d0ff53eba 100644
--- a/concordium-consensus/src/Concordium/Queries.hs
+++ b/concordium-consensus/src/Concordium/Queries.hs
@@ -12,6 +12,7 @@ module Concordium.Queries where
 import Control.Monad
 import Control.Monad.Reader
 import Data.Bifunctor (second)
+import Data.Bool.Singletons
 import Data.Foldable
 import qualified Data.HashMap.Strict as HM
 import Data.IORef
@@ -54,6 +55,7 @@ import Concordium.GlobalState.BlockMonads
 import Concordium.GlobalState.BlockPointer
 import qualified Concordium.GlobalState.BlockState as BS
 import Concordium.GlobalState.CapitalDistribution (DelegatorCapital (..))
+import Concordium.GlobalState.CooldownQueue
 import Concordium.GlobalState.Finalization
 import Concordium.GlobalState.Persistent.BlockPointer
 import Concordium.GlobalState.Persistent.BlockState
@@ -1012,7 +1014,7 @@ getAccountInfo blockHashInput acct = do
 
 -- | Get the details of an account, for the V0 consensus.
 getAccountInfoV0 :: (SkovQueryMonad m) => AccountIdentifier -> BlockState m -> m (Maybe AccountInfo)
-getAccountInfoV0 = getAccountInfoHelper getASIv0
+getAccountInfoV0 = getAccountInfoHelper getASIv0 getCooldownsV0
   where
     getASIv0 acc = do
         gd <- getGenesisData
@@ -1022,29 +1024,56 @@ getAccountInfoV0 = getAccountInfoHelper getASIv0
                         (gdGenesisTime gd)
                         (fromIntegral e * fromIntegral (gdEpochLength gd) * gdSlotDuration gd)
         toAccountStakingInfo convEpoch <$> BS.getAccountStake acc
+    -- Flexible cooldown is not supported in consensus version 0.
+    getCooldownsV0 _ = return []
 
 -- | Get the details of an account, for the V1 consensus.
 getAccountInfoV1 ::
+    forall m.
     ( BS.BlockStateQuery m,
       MonadProtocolVersion m,
+      MonadState (SkovV1.SkovData (MPV m)) m,
       IsConsensusV1 (MPV m)
     ) =>
     AccountIdentifier ->
     BlockState m ->
     m (Maybe AccountInfo)
-getAccountInfoV1 = getAccountInfoHelper getASIv1
+getAccountInfoV1 ai bs = getAccountInfoHelper getASIv1 getCooldownsV1 ai bs
   where
     getASIv1 acc = toAccountStakingInfoP4 <$> BS.getAccountStake acc
+    getCooldownsV1 acc = case sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor (MPV m))) of
+        STrue ->
+            BS.getAccountCooldowns acc >>= \case
+                Nothing -> return []
+                Just cooldowns -> do
+                    ccpEpochDuration <-
+                        BaseV1.genesisEpochDuration . SkovV1.gmParameters
+                            <$> use SkovV1.genesisMetadata
+                    seedState <- BS.getSeedState bs
+                    let SeedStateV1
+                            { ss1TriggerBlockTime = ccpTriggerTime,
+                              ss1Epoch = ccpCurrentEpoch
+                            } =
+                                seedState
+                    ccpNextPayday <- BS.getPaydayEpoch bs
+                    chainParams <- BS.getChainParameters bs
+                    let ccpRewardPeriodLength =
+                            chainParams ^. cpTimeParameters . supportedOParam . tpRewardPeriodLength
+                    let ccpCooldownDuration =
+                            chainParams ^. cpCooldownParameters . cpUnifiedCooldown
+                    return $! toCooldownList CooldownCalculationParameters{..} cooldowns
+        SFalse -> return []
 
 -- | Helper for getting the details of an account, given a function for getting the staking
 --  information.
 getAccountInfoHelper ::
     (BS.BlockStateQuery m) =>
     (Account m -> m AccountStakingInfo) ->
+    (Account m -> m [Cooldown]) ->
     AccountIdentifier ->
     BlockState m ->
     m (Maybe AccountInfo)
-getAccountInfoHelper getASI acct bs = do
+getAccountInfoHelper getASI getCooldowns acct bs = do
     macc <- case acct of
         AccAddress addr -> BS.getAccount bs addr
         AccIndex idx -> BS.getAccountByIndex bs idx
@@ -1059,6 +1088,8 @@ getAccountInfoHelper getASI acct bs = do
         aiAccountEncryptionKey <- BS.getAccountEncryptionKey acc
         aiStakingInfo <- getASI acc
         aiAccountAddress <- BS.getAccountCanonicalAddress acc
+        aiAccountCooldowns <- getCooldowns acc
+        aiAccountAvailableAmount <- BS.getAccountAvailableAmount acc
         return AccountInfo{..}
 
 -- | Get the details of a smart contract instance in the block state.

From 2882853048d82f65fd4dbc57a6b5521ae2655ad9 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Mon, 10 Jun 2024 16:46:34 +0200
Subject: [PATCH 15/81] Handle pre-pre-cooldown -> pre-cooldown -> cooldown ->
 available transitions.

---
 concordium-base                               |   2 +-
 .../Basic/BlockState/CooldownQueue.hs         |   6 +-
 .../src/Concordium/GlobalState/BlockState.hs  |  30 +++-
 .../Concordium/GlobalState/CooldownQueue.hs   |  40 +++++
 .../GlobalState/Persistent/Account.hs         |  33 +++-
 .../Persistent/Account/CooldownQueue.hs       | 154 +++++++-----------
 .../Persistent/Account/StructureV1.hs         |  70 +++++++-
 .../GlobalState/Persistent/BlockState.hs      |  89 +++++++++-
 .../GlobalState/Persistent/Cooldown.hs        |  64 +++++---
 .../src/Concordium/KonsensusV1/Scheduler.hs   |  50 +++++-
 .../src/Concordium/Kontrol/Bakers.hs          |  27 ++-
 .../Scheduler/TreeStateEnvironment.hs         |   3 +-
 12 files changed, 420 insertions(+), 148 deletions(-)

diff --git a/concordium-base b/concordium-base
index be94be822..5763aef2b 160000
--- a/concordium-base
+++ b/concordium-base
@@ -1 +1 @@
-Subproject commit be94be822015d5f4bb16a08a182e1e013a2b4b16
+Subproject commit 5763aef2b7ee0ded747dfe081e47a9f2789cfe87
diff --git a/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/CooldownQueue.hs b/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/CooldownQueue.hs
index c595ddfaf..e66a41ea7 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/CooldownQueue.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/CooldownQueue.hs
@@ -29,7 +29,7 @@ data CooldownQueue (av :: AccountVersion) where
     -- | A non-empty cooldown queue.
     --  INVARIANT: The 'Cooldowns' must not satisfy 'isEmptyCooldowns'.
     CooldownQueue ::
-        (SupportsFlexibleCooldown av ~ 'True) =>
+        (AVSupportsFlexibleCooldown av) =>
         !Cooldowns ->
         CooldownQueue av
 
@@ -65,13 +65,13 @@ isCooldownQueueEmpty _ = False
 
 -- | Convert a 'Cooldowns' to a 'CooldownQueue', using 'EmptyCooldownQueue' for the case where
 --  there are no cooldowns.
-fromCooldowns :: (SupportsFlexibleCooldown av ~ True) => Cooldowns -> CooldownQueue av
+fromCooldowns :: (AVSupportsFlexibleCooldown av) => Cooldowns -> CooldownQueue av
 fromCooldowns cooldowns
     | isEmptyCooldowns cooldowns = emptyCooldownQueue
     | otherwise = CooldownQueue cooldowns
 
 -- | Create an initial 'CooldownQueue' with only the given target amount set for pre-pre-cooldown.
-initialPrePreCooldownQueue :: (SupportsFlexibleCooldown av ~ True) => Amount -> CooldownQueue av
+initialPrePreCooldownQueue :: (AVSupportsFlexibleCooldown av) => Amount -> CooldownQueue av
 initialPrePreCooldownQueue target =
     CooldownQueue $
         Cooldowns
diff --git a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs
index 65eb99ca9..16e9dc24c 100644
--- a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs
@@ -249,7 +249,7 @@ class (BlockStateTypes m, Monad m) => AccountOperations m where
     -- | Get the 'Cooldowns' for an account, if any. This is only available at account versions that
     -- support flexible cooldowns.
     getAccountCooldowns ::
-        (SupportsFlexibleCooldown (AccountVersionFor (MPV m)) ~ True) =>
+        (PVSupportsFlexibleCooldown (MPV m)) =>
         Account m ->
         m (Maybe Cooldowns)
 
@@ -899,12 +899,36 @@ class (BlockStateQuery m) => BlockStateOperations m where
     --  the delegation from the active bakers index.
     --  For delegators pending stake reduction, this reduces the stake.
     bsoProcessPendingChanges ::
-        (PVSupportsDelegation (MPV m)) =>
+        ( PVSupportsDelegation (MPV m),
+          SupportsFlexibleCooldown (AccountVersionFor (MPV m)) ~ 'False
+        ) =>
         UpdatableBlockState m ->
         -- | Guard determining if a change is effective
         (Timestamp -> Bool) ->
         m (UpdatableBlockState m)
 
+    -- | Process cooldowns on accounts that have expired, and move pre-cooldowns into cooldown.
+    --  All cooldowns that expire at or before the given expiry time will be removed from accounts.
+    --  After this, all pre-cooldowns on accounts are moved into cooldown.
+    bsoProcessCooldowns ::
+        (PVSupportsFlexibleCooldown (MPV m)) =>
+        UpdatableBlockState m ->
+        -- | Timestamp for expiring cooldowns.
+        Timestamp ->
+        -- | Timestamp for pre-cooldowns entering cooldown.
+        Timestamp ->
+        m (UpdatableBlockState m)
+
+    -- | Move all pre-pre-cooldowns into pre-cooldown.
+    --  It is assumed that there are currently no pre-cooldowns. This should be ensured by
+    --  calling 'bsoProcessCooldowns' between successive calls to 'bsoProcessPrePreCooldowns', as
+    --  that moves all pre-cooldowns into cooldown, and only 'bsoProcessPrePreCooldowns' moves
+    --  anything into pre-cooldown.
+    bsoProcessPrePreCooldowns ::
+        (PVSupportsFlexibleCooldown (MPV m)) =>
+        UpdatableBlockState m ->
+        m (UpdatableBlockState m)
+
     -- | Get the list of all active bakers in ascending order.
     bsoGetActiveBakers :: UpdatableBlockState m -> m [BakerId]
 
@@ -1614,6 +1638,8 @@ instance (Monad (t m), MonadTrans t, BlockStateOperations m) => BlockStateOperat
     bsoSetSeedState s ss = lift $ bsoSetSeedState s ss
     bsoRotateCurrentEpochBakers = lift . bsoRotateCurrentEpochBakers
     bsoProcessPendingChanges s g = lift $ bsoProcessPendingChanges s g
+    bsoProcessCooldowns s expiry cooldown = lift $ bsoProcessCooldowns s expiry cooldown
+    bsoProcessPrePreCooldowns = lift . bsoProcessPrePreCooldowns
     bsoTransitionEpochBakers s e = lift $ bsoTransitionEpochBakers s e
     bsoGetActiveBakers = lift . bsoGetActiveBakers
     bsoGetActiveBakersAndDelegators = lift . bsoGetActiveBakersAndDelegators
diff --git a/concordium-consensus/src/Concordium/GlobalState/CooldownQueue.hs b/concordium-consensus/src/Concordium/GlobalState/CooldownQueue.hs
index 752ad022e..804aeed8f 100644
--- a/concordium-consensus/src/Concordium/GlobalState/CooldownQueue.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/CooldownQueue.hs
@@ -95,6 +95,46 @@ cooldownTotal Cooldowns{..} =
 instance HashableTo Hash.Hash Cooldowns where
     getHash = getHash . encode
 
+-- | Remove any amounts in cooldown with timestamp before or equal to the given timestamp.
+processCooldowns :: Timestamp -> Cooldowns -> Cooldowns
+processCooldowns ts Cooldowns{..} =
+    Cooldowns
+        { inCooldown = snd $ Map.split ts inCooldown,
+          ..
+        }
+
+-- | Transfer the pre-cooldown to cooldown with the specified expiry timestamp.
+processPreCooldown :: Timestamp -> Cooldowns -> Cooldowns
+processPreCooldown _ c@Cooldowns{preCooldown = Absent} = c
+processPreCooldown expiry Cooldowns{preCooldown = Present preAmt, ..} =
+    Cooldowns
+        { inCooldown = Map.insert expiry preAmt inCooldown,
+          preCooldown = Absent,
+          ..
+        }
+
+-- | Transfer the pre-pre-cooldown to pre-cooldown.
+-- If there is already an amount in pre-cooldown, the two amounts are combined.
+processPrePreCooldown :: Cooldowns -> Cooldowns
+processPrePreCooldown c@Cooldowns{prePreCooldown = Absent} = c
+processPrePreCooldown Cooldowns{preCooldown = Absent, ..} =
+    Cooldowns
+        { preCooldown = prePreCooldown,
+          prePreCooldown = Absent,
+          ..
+        }
+processPrePreCooldown Cooldowns{preCooldown = Present preAmt, prePreCooldown = Present prePreAmt, ..} =
+    Cooldowns
+        { preCooldown = Present (preAmt + prePreAmt),
+          prePreCooldown = Absent,
+          ..
+        }
+
+-- | Get the timestamp of the first cooldown that will expire, if any.
+-- (This ignores pre-cooldown and pre-pre-cooldown.)
+firstCooldownTimestamp :: Cooldowns -> Maybe Timestamp
+firstCooldownTimestamp Cooldowns{..} = fst <$> Map.lookupMin inCooldown
+
 data CooldownCalculationParameters = CooldownCalculationParameters
     { ccpEpochDuration :: Duration,
       ccpCurrentEpoch :: Epoch,
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs
index 5b4553ac6..96247a011 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs
@@ -272,7 +272,7 @@ accountStakeDetails (PAV3 acc) = V1.getStakeDetails acc
 -- | Get the 'Cooldowns' for an account, if any. This is only available at account versions that
 -- support flexible cooldowns.
 accountCooldowns ::
-    (MonadBlobStore m, SupportsFlexibleCooldown av ~ 'True) =>
+    (MonadBlobStore m, AVSupportsFlexibleCooldown av) =>
     PersistentAccount av ->
     m (Maybe Cooldowns)
 accountCooldowns (PAV3 acc) = V1.getCooldowns acc
@@ -516,6 +516,37 @@ unlockAccountReleases ts (PAV1 acc) = second PAV1 <$> V0.unlockReleases ts acc
 unlockAccountReleases ts (PAV2 acc) = second PAV2 <$> V1.unlockReleases ts acc
 unlockAccountReleases ts (PAV3 acc) = second PAV3 <$> V1.unlockReleases ts acc
 
+-- | Process the cooldowns on an account up to and including the given timestamp.
+--  This returns the next timestamp at which a cooldown expires, if any.
+processAccountCooldownsUntil ::
+    (MonadBlobStore m, AVSupportsFlexibleCooldown av) =>
+    Timestamp ->
+    PersistentAccount av ->
+    m (Maybe Timestamp, PersistentAccount av)
+processAccountCooldownsUntil ts (PAV3 acc) =
+    second PAV3 <$> V1.processCooldownsUntil ts acc
+
+-- | Move the pre-cooldown amount on an account into cooldown with the specified release time.
+--  This returns @Just (Just ts)@ if the previous next cooldown time was @ts@, but the new next
+--  cooldown (i.e. the supplied timestamp) time is earlier. It returns @Just Nothing@ if the account
+--  did not have a cooldown but now does. Otherwise, it returns @Nothing@.
+processAccountPreCooldown ::
+    (MonadBlobStore m, AVSupportsFlexibleCooldown av) =>
+    Timestamp ->
+    PersistentAccount av ->
+    m (Maybe (Maybe Timestamp), PersistentAccount av)
+processAccountPreCooldown ts (PAV3 acc) = second PAV3 <$> V1.processPreCooldown ts acc
+
+-- | Move the pre-pre-cooldown amount on an account into pre-cooldown.
+--  It should be the case that the account has a pre-pre-cooldown amount and no pre-cooldown amount.
+--  However, if there is no pre-pre-cooldown amount, this will do nothing, and if there is already
+--  a pre-cooldown amount, the pre-pre-cooldown amount will be added to it.
+processAccountPrePreCooldown ::
+    (MonadBlobStore m, AVSupportsFlexibleCooldown av) =>
+    PersistentAccount av ->
+    m (PersistentAccount av)
+processAccountPrePreCooldown (PAV3 acc) = PAV3 <$> V1.processPrePreCooldown acc
+
 -- * Creation
 
 -- | Make a persistent account from a transient account.
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/CooldownQueue.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/CooldownQueue.hs
index 4cf37043b..9060f9d7d 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/CooldownQueue.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/CooldownQueue.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE KindSignatures #-}
@@ -18,7 +19,7 @@ import Concordium.Utils
 
 import Concordium.GlobalState.Account
 import qualified Concordium.GlobalState.Basic.BlockState.CooldownQueue as Transient
-import Concordium.GlobalState.CooldownQueue
+import Concordium.GlobalState.CooldownQueue as Cooldowns
 import Concordium.GlobalState.Persistent.BlobStore
 import Concordium.Types.Option
 
@@ -31,7 +32,7 @@ data CooldownQueue (av :: AccountVersion) where
     -- | A non-empty cooldown queue.
     --  INVARIANT: The 'Cooldowns' must not satisfy 'isEmptyCooldowns'.
     CooldownQueue ::
-        (SupportsFlexibleCooldown av ~ 'True) =>
+        (AVSupportsFlexibleCooldown av) =>
         !(EagerBufferedRef Cooldowns) ->
         CooldownQueue av
 
@@ -76,6 +77,15 @@ isCooldownQueueEmpty :: CooldownQueue av -> Bool
 isCooldownQueueEmpty EmptyCooldownQueue = True
 isCooldownQueueEmpty _ = False
 
+-- | Construct a 'CooldownQueue' from a 'Cooldowns', which may be empty.
+makeCooldownQueue ::
+    (MonadBlobStore m, AVSupportsFlexibleCooldown av) =>
+    Cooldowns ->
+    m (CooldownQueue av)
+makeCooldownQueue cooldowns
+    | isEmptyCooldowns cooldowns = return EmptyCooldownQueue
+    | otherwise = CooldownQueue <$> refMake cooldowns
+
 makePersistentCooldownQueue ::
     (MonadBlobStore m) =>
     Transient.CooldownQueue av ->
@@ -90,7 +100,7 @@ toTransientCooldownQueue (CooldownQueue queueRef) =
 
 -- | Create an initial 'CooldownQueue' with only the given amount set in pre-pre-cooldown.
 initialPrePreCooldownQueue ::
-    (MonadBlobStore m, SupportsFlexibleCooldown av ~ True) =>
+    (MonadBlobStore m, AVSupportsFlexibleCooldown av) =>
     -- | Initial amount in pre-pre-cooldown.
     Amount ->
     m (CooldownQueue av)
@@ -114,96 +124,56 @@ cooldownStake :: CooldownQueue av -> Amount
 cooldownStake EmptyCooldownQueue = 0
 cooldownStake (CooldownQueue queueRef) = cooldownTotal $ eagerBufferedDeref queueRef
 
-{-
--- | Convert a 'Cooldowns' to a 'CooldownQueue', using 'EmptyCooldownQueue' for the case where
---  there are no cooldowns.
-fromCooldowns :: (SupportsFlexibleCooldown av ~ True) => Cooldowns -> CooldownQueue av
-fromCooldowns cooldowns
-    | isEmptyCooldowns cooldowns = emptyCooldownQueue
-    | otherwise = CooldownQueue cooldowns
-
 -- | Process all cooldowns that expire at or before the given timestamp.
---  If there are no such cooldowns, then 'Nothing' is returned.
---  Otherwise, the total amount exiting cooldown and the remaining queue are returned.
-processCooldowns :: Timestamp -> CooldownQueue av -> Maybe (Amount, CooldownQueue av)
-processCooldowns _ EmptyCooldownQueue = Nothing
-processCooldowns ts (CooldownQueue queue)
-    | freeAmount == 0 = Nothing
-    | otherwise = Just (freeAmount, remainder)
-  where
-    freeAmount = sum free + sum bonus
-    (free, bonus, keep) = Map.splitLookup ts (inCooldown queue)
-    remainder = fromCooldowns (queue{inCooldown = keep})
-
--- | Process the pre-cooldown (if any). The active stake is reduced to the new target stake, and
--- the remaining stake is added to the cooldown queue.
+--   This returns the next timestamp at which a cooldown expires, if any.
+processCooldownsUntil ::
+    (MonadBlobStore m) =>
+    -- | Release all cooldowns up to and including this timestamp.
+    Timestamp ->
+    CooldownQueue av ->
+    m (Maybe Timestamp, CooldownQueue av)
+processCooldownsUntil _ EmptyCooldownQueue = return (Nothing, EmptyCooldownQueue)
+processCooldownsUntil ts (CooldownQueue queueRef) = do
+    let !newCooldowns = processCooldowns ts $ eagerBufferedDeref queueRef
+    let !nextTimestamp = firstCooldownTimestamp newCooldowns
+    newQueue <- makeCooldownQueue newCooldowns
+    return (nextTimestamp, newQueue)
+
+-- | Move the pre-cooldown amount on into cooldown with the specified release time.
+--  This returns @Just (Just ts)@ if the previous next cooldown time was @ts@, but the new next
+--  cooldown (i.e. the supplied timestamp) time is earlier. It returns @Just Nothing@ if there was
+--  no cooldown but now there is. Otherwise, it returns @Nothing@.
 processPreCooldown ::
-    -- | Timestamp at which the cooldown should expire.
+    (MonadBlobStore m) =>
+    -- | The timestamp at which the pre-cooldown should be released.
     Timestamp ->
-    -- | Current active stake.
-    Amount ->
-    -- | Current cooldown queue.
     CooldownQueue av ->
-    -- | If a change is required, the new active stake and cooldown queue.
-    Maybe (Amount, CooldownQueue av)
-processPreCooldown _ _ EmptyCooldownQueue = Nothing
-processPreCooldown ts stake (CooldownQueue cooldowns@Cooldowns{..}) =
-    ofOption Nothing (Just . cooldownWithTarget) preCooldownTargetStake
-  where
-    cooldownsNoPre = cooldowns{preCooldownTargetStake = Absent}
-    cooldownWithTarget targetStake
-        | stake == 0 || targetStake >= stake = (stake, fromCooldowns cooldownsNoPre)
-        | otherwise =
-            ( targetStake,
-              fromCooldowns
-                cooldownsNoPre
-                    { inCooldown = Map.alter (Just . (+ (stake - targetStake)) . fromMaybe 0) ts inCooldown
-                    }
-            )
-
--- | Move all pre-cooldowns into cooldown state. Where the pre-cooldown has a timestamp set, that
--- is used. Otherwise, the timestamp is used. This returns 'Nothing' if the queue would not be
--- changed, i.e. there are no pre-cooldowns.
--- Note, this will predominantly be used when there is at most one pre-cooldown, and it has no
--- timestamp set. Thus, this is not particularly optimized for other cases.
-processPreCooldown :: Timestamp -> Amount -> CooldownQueue av -> Maybe (Amount, CooldownQueue av)
-processPreCooldown _ _ EmptyCooldownQueue = Nothing
-processPreCooldown ts stake (CooldownQueue queue)
-    | null precooldowns = Nothing
-    | tsMillis ts > theCooldownTimeCode maxCooldownTimestampCode = error "Timestamp out of bounds"
-    | otherwise = Just (newStake, newQueue)
-  where
-    newQueue = CooldownQueue $ Map.unionsWith (+) [newCooldowns, preprecooldowns]
-    (cooldowns, rest) = Map.spanAntitone (<= maxCooldownTimestampCode) queue
-    (precooldowns, preprecooldowns) = Map.spanAntitone (<= encodeCooldownTime PreCooldown) rest
-    (newStake, newCooldowns) = Map.foldlWithKey' ff (stake, cooldowns) precooldowns
-    ff (staked, accCooldowns) tc amt
-        | staked == 0 = (staked, accCooldowns)
-        | staked < amt = (staked, accCooldowns)
-        | otherwise = (amt, Map.alter (Just . (+ (staked - amt)) . fromMaybe 0) (f tc) accCooldowns)
-    f c@(CooldownTimeCode code)
-        | c == encodeCooldownTime PreCooldown = CooldownTimeCode $ tsMillis ts
-        | otherwise = CooldownTimeCode (Bits.clearBit code 63)
-
--- | Get the next timestamp (if any) at which a cooldown is scheduled to elapse.
-nextCooldownTime :: CooldownQueue av -> Maybe Timestamp
-nextCooldownTime EmptyCooldownQueue = Nothing
-nextCooldownTime (CooldownQueue queue) = case decodeCooldownTime minEntry of
-    CooldownTimestamp ts -> Just ts
-    _ -> Nothing
-  where
-    -- This is safe because 'CooldownQueue' requires @queue@ to be non-empty.
-    (minEntry, _) = Map.findMin queue
-
--- | Check if a 'CooldownQueue' has any pre-cooldown entries.
-hasPreCooldown :: CooldownQueue av -> Bool
-hasPreCooldown EmptyCooldownQueue = False
-hasPreCooldown (CooldownQueue queue) = case Map.lookupGT maxCooldownTimestampCode queue of
-    Just (x, _) -> x <= encodeCooldownTime PreCooldown
-    Nothing -> False
-
--- | Check if a 'CooldownQueue' has any pre-pre-cooldown entries.
-hasPrePreCooldown :: CooldownQueue av -> Bool
-hasPrePreCooldown EmptyCooldownQueue = False
-hasPrePreCooldown (CooldownQueue queue) = isJust $ Map.lookupGT (encodeCooldownTime PreCooldown) queue
--}
+    m (Maybe (Maybe Timestamp), CooldownQueue av)
+processPreCooldown _ EmptyCooldownQueue = return (Nothing, EmptyCooldownQueue)
+processPreCooldown ts (CooldownQueue queueRef) = do
+    let oldCooldowns = eagerBufferedDeref queueRef
+    let !newCooldowns = Cooldowns.processPreCooldown ts oldCooldowns
+    let oldNextTimestamp = firstCooldownTimestamp oldCooldowns
+    let nextTimestamp = firstCooldownTimestamp newCooldowns
+    let !res
+            | Just oldTS <- oldNextTimestamp,
+              Just nextTS <- nextTimestamp,
+              nextTS < oldTS =
+                Just (Just oldTS)
+            | Nothing <- oldNextTimestamp,
+              Just _ <- nextTimestamp =
+                Just Nothing
+            | otherwise = Nothing
+    newQueue <- makeCooldownQueue newCooldowns
+    return (res, newQueue)
+
+-- | Move the pre-pre-cooldown amount on into pre-cooldown.
+--  It should be the case that there is a pre-pre-cooldown amount and no pre-cooldown amount.
+--  However, if there is no pre-pre-cooldown amount, this will do nothing, and if there is already
+--  a pre-cooldown amount, the pre-pre-cooldown amount will be added to it.
+processPrePreCooldown :: (MonadBlobStore m) => CooldownQueue av -> m (CooldownQueue av)
+processPrePreCooldown EmptyCooldownQueue = return EmptyCooldownQueue
+processPrePreCooldown (CooldownQueue queueRef) = do
+    let oldCooldowns = eagerBufferedDeref queueRef
+    let !newCooldowns = Cooldowns.processPrePreCooldown oldCooldowns
+    makeCooldownQueue newCooldowns
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
index e7418c286..328747cae 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
@@ -42,8 +42,8 @@ import qualified Concordium.GlobalState.Basic.BlockState.Account as Transient
 import qualified Concordium.GlobalState.Basic.BlockState.AccountReleaseSchedule as TARS
 import qualified Concordium.GlobalState.Basic.BlockState.AccountReleaseScheduleV1 as TARSV1
 import Concordium.GlobalState.BlockState (AccountAllowance (..))
-import Concordium.GlobalState.CooldownQueue
-import Concordium.GlobalState.Persistent.Account.CooldownQueue
+import Concordium.GlobalState.CooldownQueue (Cooldowns)
+import Concordium.GlobalState.Persistent.Account.CooldownQueue as CooldownQueue
 import Concordium.GlobalState.Persistent.Account.EncryptedAmount
 import Concordium.GlobalState.Persistent.Account.MigrationStateInterface
 import qualified Concordium.GlobalState.Persistent.Account.StructureV0 as V0
@@ -1038,7 +1038,7 @@ getStakeCooldown acc = do
     return $ paedStakeCooldown ed
 
 getCooldowns ::
-    (MonadBlobStore m, SupportsFlexibleCooldown av ~ 'True) =>
+    (MonadBlobStore m, AVSupportsFlexibleCooldown av) =>
     PersistentAccount av ->
     m (Maybe Cooldowns)
 getCooldowns =
@@ -1402,6 +1402,70 @@ unlockReleases ts acc = do
             let !newAcc = acc{accountEnduringData = newEnduring}
             return (nextTimestamp, newAcc)
 
+-- | Process the cooldowns on an account up to and including the given timestamp.
+--  This returns the next timestamp at which a cooldown expires, if any.
+--
+--  Note: this should only be called if the account has cooldowns which expire at or before the
+--  given timestamp, as otherwise the account will be updated unnecessarily.
+processCooldownsUntil ::
+    ( MonadBlobStore m,
+      AVSupportsFlexibleCooldown av,
+      IsAccountVersion av,
+      AccountStructureVersionFor av ~ 'AccountStructureV1
+    ) =>
+    -- | Release all cooldowns up to and including this timestamp.
+    Timestamp ->
+    PersistentAccount av ->
+    m (Maybe Timestamp, PersistentAccount av)
+processCooldownsUntil ts acc = do
+    let ed = enduringData acc
+    (nextTimestamp, newQueue) <- CooldownQueue.processCooldownsUntil ts (paedStakeCooldown ed)
+    newEnduring <- refMake =<< rehashAccountEnduringData ed{paedStakeCooldown = newQueue}
+    return (nextTimestamp, acc{accountEnduringData = newEnduring})
+
+-- | Move the pre-cooldown amount on an account into cooldown with the specified release time.
+--  This returns @Just (Just ts)@ if the previous next cooldown time was @ts@, but the new next
+--  cooldown (i.e. the supplied timestamp) time is earlier. It returns @Just Nothing@ if the account
+--  did not have a cooldown but now does. Otherwise, it returns @Nothing@.
+--
+--  Note: this should only be called if the account has a pre-cooldown, as otherwise the account
+--  will be updated unnecessarily.
+processPreCooldown ::
+    ( MonadBlobStore m,
+      AVSupportsFlexibleCooldown av,
+      IsAccountVersion av,
+      AccountStructureVersionFor av ~ 'AccountStructureV1
+    ) =>
+    Timestamp ->
+    PersistentAccount av ->
+    m (Maybe (Maybe Timestamp), PersistentAccount av)
+processPreCooldown ts acc = do
+    let ed = enduringData acc
+    (res, newQueue) <- CooldownQueue.processPreCooldown ts (paedStakeCooldown ed)
+    newEnduring <- refMake =<< rehashAccountEnduringData ed{paedStakeCooldown = newQueue}
+    return (res, acc{accountEnduringData = newEnduring})
+
+-- | Move the pre-pre-cooldown amount on an account into pre-cooldown.
+--  It should be the case that the account has a pre-pre-cooldown amount and no pre-cooldown amount.
+--  However, if there is no pre-pre-cooldown amount, this will do nothing, and if there is already
+--  a pre-cooldown amount, the pre-pre-cooldown amount will be added to it.
+--
+--  Note: this should only be called if the account has a pre-pre-cooldown, as otherwise the account
+--  will be updated unnecessarily.
+processPrePreCooldown ::
+    ( MonadBlobStore m,
+      AVSupportsFlexibleCooldown av,
+      IsAccountVersion av,
+      AccountStructureVersionFor av ~ 'AccountStructureV1
+    ) =>
+    PersistentAccount av ->
+    m (PersistentAccount av)
+processPrePreCooldown acc = do
+    let ed = enduringData acc
+    newQueue <- CooldownQueue.processPrePreCooldown (paedStakeCooldown ed)
+    newEnduring <- refMake =<< rehashAccountEnduringData ed{paedStakeCooldown = newQueue}
+    return acc{accountEnduringData = newEnduring}
+
 -- ** Creation
 
 -- | Make a 'PersistentAccount' from an 'Transient.Account'.
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
index c65202ce7..d39f6fa35 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
@@ -2080,7 +2080,9 @@ doUpdateBakerStake pbs ai newStake = do
                 do
                     let curEpoch = bspBirkParameters bsp ^. birkSeedState . epoch
                     upds <- refLoad (bspUpdates bsp)
-                    cooldown <- (2 +) . _cpBakerExtraCooldownEpochs . _cpCooldownParameters . unStoreSerialized <$> refLoad (currentParameters upds)
+                    cooldownEpochs <-
+                        (2 +) . _cpBakerExtraCooldownEpochs . _cpCooldownParameters . unStoreSerialized
+                            <$> refLoad (currentParameters upds)
 
                     bakerStakeThreshold <- (^. cpPoolParameters . ppBakerStakeThreshold) <$> doGetChainParameters pbs
                     let applyUpdate updAcc = do
@@ -2091,10 +2093,10 @@ doUpdateBakerStake pbs ai newStake = do
                             if newStake < bakerStakeThreshold
                                 then return (BSUStakeUnderThreshold, pbs)
                                 else
-                                    (BSUStakeReduced (BakerId ai) (curEpoch + cooldown),)
+                                    (BSUStakeReduced (BakerId ai) (curEpoch + cooldownEpochs),)
                                         <$> applyUpdate
                                             ( setAccountStakePendingChange
-                                                (BaseAccounts.ReduceStake newStake (BaseAccounts.PendingChangeEffectiveV0 $ curEpoch + cooldown))
+                                                (BaseAccounts.ReduceStake newStake (BaseAccounts.PendingChangeEffectiveV0 $ curEpoch + cooldownEpochs))
                                             )
                         EQ -> return (BSUStakeUnchanged (BakerId ai), pbs)
                         GT -> (BSUStakeIncreased (BakerId ai),) <$> applyUpdate (setAccountStake newStake)
@@ -2137,12 +2139,17 @@ doRemoveBaker pbs ai = do
                     -- transition.
                     let curEpoch = bspBirkParameters bsp ^. birkSeedState . epoch
                     upds <- refLoad (bspUpdates bsp)
-                    cooldown <- (2 +) . _cpBakerExtraCooldownEpochs . _cpCooldownParameters . unStoreSerialized <$> refLoad (currentParameters upds)
+                    cooldownEpochs <-
+                        (2 +) . _cpBakerExtraCooldownEpochs . _cpCooldownParameters . unStoreSerialized
+                            <$> refLoad (currentParameters upds)
                     let updAcc =
                             setAccountStakePendingChange $
-                                BaseAccounts.RemoveStake (BaseAccounts.PendingChangeEffectiveV0 $ curEpoch + cooldown)
+                                BaseAccounts.RemoveStake $
+                                    BaseAccounts.PendingChangeEffectiveV0 $
+                                        curEpoch + cooldownEpochs
                     newAccounts <- Accounts.updateAccountsAtIndex' updAcc ai (bspAccounts bsp)
-                    (BRRemoved (BakerId ai) (curEpoch + cooldown),) <$> storePBS pbs bsp{bspAccounts = newAccounts}
+                    (BRRemoved (BakerId ai) (curEpoch + cooldownEpochs),)
+                        <$> storePBS pbs bsp{bspAccounts = newAccounts}
         -- The account is not valid or has no baker
         _ -> return (BRInvalidBaker, pbs)
 
@@ -3420,6 +3427,74 @@ doProcessPendingChanges persistentBS isEffective = do
         newAccounts <- lift $ Accounts.updateAccountsAtIndex' updAcc accId accounts
         _1 .=! newAccounts
 
+-- | Process cooldowns on accounts that have expired, and move pre-cooldowns into cooldown.
+doProcessCooldowns ::
+    forall pv m.
+    (SupportsPersistentState pv m, PVSupportsFlexibleCooldown pv) =>
+    PersistentBlockState pv ->
+    -- | Timestamp for expiring cooldowns.
+    Timestamp ->
+    -- | Timestamp for pre-cooldowns entering cooldown.
+    Timestamp ->
+    m (PersistentBlockState pv)
+doProcessCooldowns pbs now newExpiry = do
+    bsp <- loadPBS pbs
+    (newAIC, newAccts) <-
+        MTL.execStateT
+            process
+            (bspAccountsInCooldown bsp ^. accountsInCooldown, bspAccounts bsp)
+    storePBS pbs $
+        bsp
+            { bspAccountsInCooldown = AccountsInCooldownForPV (CTrue newAIC),
+              bspAccounts = newAccts
+            }
+  where
+    withCooldown a = (_1 . cooldown .=) =<< a =<< use (_1 . cooldown)
+    withAccounts a = (_2 .=) =<< a =<< use _2
+    process = do
+        cooldown0 <- use (_1 . cooldown)
+        (cooldownList, cooldown1) <- processReleasesUntil now cooldown0
+        _1 . cooldown .= cooldown1
+        forM_ cooldownList $ \acc -> do
+            withAccounts (Accounts.updateAccountsAtIndex' (processCooldownForAccount acc) acc)
+        preCooldownAL <- _1 . preCooldown <<.= Null
+        preCooldowns <- loadAccountList preCooldownAL
+        forM_ preCooldowns $ \acc -> do
+            withAccounts (Accounts.updateAccountsAtIndex' (processPreCooldownForAccount acc) acc)
+    processCooldownForAccount acc pa = do
+        (mNextCooldown, newPA) <- processAccountCooldownsUntil now pa
+        forM_ mNextCooldown $ \nextCooldown -> withCooldown $ addAccountRelease nextCooldown acc
+        return newPA
+    processPreCooldownForAccount acc pa = do
+        (res, newPA) <- processAccountPreCooldown newExpiry pa
+        case res of
+            Just (Just oldTS) -> withCooldown $ updateAccountRelease oldTS newExpiry acc
+            Just Nothing -> withCooldown $ addAccountRelease newExpiry acc
+            Nothing -> return ()
+        return newPA
+
+doProcessPrePreCooldowns ::
+    forall pv m.
+    (SupportsPersistentState pv m, PVSupportsFlexibleCooldown pv) =>
+    PersistentBlockState pv ->
+    m (PersistentBlockState pv)
+doProcessPrePreCooldowns pbs = do
+    bsp <- loadPBS pbs
+    let oldAIC = bspAccountsInCooldown bsp ^. accountsInCooldown
+    let !newPreCooldown = assert (isNull (oldAIC ^. preCooldown)) $ oldAIC ^. prePreCooldown
+    let newAIC =
+            oldAIC
+                & preCooldown .~ newPreCooldown
+                & prePreCooldown .~ Null
+    accounts <- loadAccountList newPreCooldown
+    let processAccount = flip $ Accounts.updateAccountsAtIndex' processAccountPrePreCooldown
+    newAccts <- foldM processAccount (bspAccounts bsp) accounts
+    storePBS pbs $
+        bsp
+            { bspAccountsInCooldown = AccountsInCooldownForPV (CTrue newAIC),
+              bspAccounts = newAccts
+            }
+
 doGetBankStatus :: (SupportsPersistentState pv m) => PersistentBlockState pv -> m Rewards.BankStatus
 doGetBankStatus pbs = _unhashed . bspBank <$> loadPBS pbs
 
@@ -3687,6 +3762,8 @@ instance (IsProtocolVersion pv, PersistentState av pv r m) => BlockStateOperatio
     bsoRotateCurrentEpochBakers = doRotateCurrentEpochBakers
     bsoSetNextEpochBakers = doSetNextEpochBakers
     bsoProcessPendingChanges = doProcessPendingChanges
+    bsoProcessCooldowns = doProcessCooldowns
+    bsoProcessPrePreCooldowns = doProcessPrePreCooldowns
     bsoGetBankStatus = doGetBankStatus
     bsoSetRewardAccounts = doSetRewardAccounts
     bsoIsProtocolUpdateEffective = doIsProtocolUpdateEffective
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Cooldown.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Cooldown.hs
index 88ce6812c..b626e1b29 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Cooldown.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Cooldown.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 
@@ -8,6 +9,7 @@ module Concordium.GlobalState.Persistent.Cooldown where
 
 import Data.Bool.Singletons
 import Data.Serialize
+import Lens.Micro.Platform
 
 import Concordium.GlobalState.Persistent.BlobStore
 import Concordium.GlobalState.Persistent.ReleaseSchedule
@@ -54,36 +56,36 @@ migrateAccountList (Some ubRef) = do
 
 -- | This is an indexing structure and therefore does not need to be hashed. FIXME: add more docs
 data AccountsInCooldown = AccountsInCooldown
-    { cooldown :: !NewReleaseSchedule,
-      preCooldown :: !AccountList,
-      prePreCooldown :: !AccountList
+    { _cooldown :: !NewReleaseSchedule,
+      _preCooldown :: !AccountList,
+      _prePreCooldown :: !AccountList
     }
 
+makeLenses ''AccountsInCooldown
+
 -- | The cacheable instance only caches the 'cooldown' field, since the
 --  'preCooldown' and 'prePreCooldown' are implemented using 'UnbufferedRef's (and so
 --  would have no benefit from caching).
 instance (MonadBlobStore m) => Cacheable m AccountsInCooldown where
-    cache aic = do
-        newCooldown <- cache (cooldown aic)
-        return aic{cooldown = newCooldown}
+    cache = cooldown cache
 
 instance (MonadBlobStore m) => BlobStorable m AccountsInCooldown where
     load = do
-        cooldown <- load
-        preCooldown <- load
-        prePreCooldown <- load
-        return (AccountsInCooldown <$> cooldown <*> preCooldown <*> prePreCooldown)
+        mCooldown <- load
+        mPreCooldown <- load
+        mPrePreCooldown <- load
+        return (AccountsInCooldown <$> mCooldown <*> mPreCooldown <*> mPrePreCooldown)
     storeUpdate aic = do
-        (pCooldown, newCooldown) <- storeUpdate (cooldown aic)
-        (pPreCooldown, newPreCooldown) <- storeUpdate (preCooldown aic)
-        (pPrePreCooldown, newPrePreCooldown) <- storeUpdate (prePreCooldown aic)
+        (pCooldown, newCooldown) <- storeUpdate (_cooldown aic)
+        (pPreCooldown, newPreCooldown) <- storeUpdate (_preCooldown aic)
+        (pPrePreCooldown, newPrePreCooldown) <- storeUpdate (_prePreCooldown aic)
         let putAIC = pCooldown >> pPreCooldown >> pPrePreCooldown
         return
             ( putAIC,
               AccountsInCooldown
-                { cooldown = newCooldown,
-                  preCooldown = newPreCooldown,
-                  prePreCooldown = newPrePreCooldown
+                { _cooldown = newCooldown,
+                  _preCooldown = newPreCooldown,
+                  _prePreCooldown = newPrePreCooldown
                 }
             )
 
@@ -91,9 +93,9 @@ instance (MonadBlobStore m) => BlobStorable m AccountsInCooldown where
 emptyAccountsInCooldown :: AccountsInCooldown
 emptyAccountsInCooldown =
     AccountsInCooldown
-        { cooldown = emptyNewReleaseSchedule,
-          preCooldown = Null,
-          prePreCooldown = Null
+        { _cooldown = emptyNewReleaseSchedule,
+          _preCooldown = Null,
+          _prePreCooldown = Null
         }
 
 -- | Migrate 'AccountsInCooldown' from one 'BlobStore' to another.
@@ -102,14 +104,14 @@ migrateAccountsInCooldown ::
     AccountsInCooldown ->
     t m AccountsInCooldown
 migrateAccountsInCooldown aic = do
-    newCooldown <- migrateNewReleaseSchedule (cooldown aic)
-    newPreCooldown <- migrateAccountList (preCooldown aic)
-    newPrePreCooldown <- migrateAccountList (prePreCooldown aic)
+    newCooldown <- migrateNewReleaseSchedule (_cooldown aic)
+    newPreCooldown <- migrateAccountList (_preCooldown aic)
+    newPrePreCooldown <- migrateAccountList (_prePreCooldown aic)
     return $!
         AccountsInCooldown
-            { cooldown = newCooldown,
-              preCooldown = newPreCooldown,
-              prePreCooldown = newPrePreCooldown
+            { _cooldown = newCooldown,
+              _preCooldown = newPreCooldown,
+              _prePreCooldown = newPrePreCooldown
             }
 
 newtype AccountsInCooldownForPV pv = AccountsInCooldownForPV
@@ -127,6 +129,16 @@ instance (MonadBlobStore m, IsProtocolVersion pv) => BlobStorable m (AccountsInC
         (paic, aic') <- storeUpdate aic
         return (paic, AccountsInCooldownForPV (CTrue aic'))
 
+-- | A lens for accessing the 'AccountsInCooldown' in an 'AccountsInCooldownForPV' when the
+--  protocol version supports flexible cooldown.
+accountsInCooldown ::
+    (PVSupportsFlexibleCooldown pv) =>
+    Lens' (AccountsInCooldownForPV pv) AccountsInCooldown
+accountsInCooldown =
+    lens
+        (uncond . theAccountsInCooldownForPV)
+        (\_ aic -> AccountsInCooldownForPV (CTrue aic))
+
 -- | An 'AccountsInCooldownForPV' with no accounts in (pre)*cooldown.
 emptyAccountsInCooldownForPV ::
     forall pv.
@@ -168,7 +180,7 @@ migrateAccountsInCooldownForPV =
             SFalse -> \(CTrue prePreCooldownAccts) _ ->
                 return
                     ( AccountsInCooldownForPV
-                        (CTrue (emptyAccountsInCooldown{prePreCooldown = prePreCooldownAccts}))
+                        (CTrue (emptyAccountsInCooldown{_prePreCooldown = prePreCooldownAccts}))
                     )
             STrue -> \_ (AccountsInCooldownForPV (CTrue oldAIC)) ->
                 AccountsInCooldownForPV . CTrue <$> migrateAccountsInCooldown oldAIC
diff --git a/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs b/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs
index e86508bd2..dbd91d2e8 100644
--- a/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs
+++ b/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs
@@ -1,11 +1,13 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE EmptyDataDeriving #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 
 module Concordium.KonsensusV1.Scheduler where
 
 import Control.Monad
+import Data.Bool.Singletons
 import qualified Data.Map as Map
 import Data.Time
 import Lens.Micro.Platform
@@ -114,6 +116,31 @@ data PrologueResult m = PrologueResult
 
 -- * Block prologue
 
+-- | Handle cooldown events for a payday. Prior to protocol version 7, the cooldowns are processed
+--  with 'bsoProcessPendingChanges': bakers and delegators that have a cooldown that elapses by the
+--  trigger time of the previous epoch are processed, with their funds being released and their
+--  baker/delegator status being updated as appropriate. From protocol version 7 onwards, the
+--  cooldowns are processed with 'bsoProcessCooldowns': bakers and delegators that have a cooldown
+--  that elapses by the trigger time of the previous epoch are processed, with their funds being
+--  released (their status is not updated, as it was already updated before entering cooldown);
+--  moreover, accounts that have a pre-cooldown set will enter cooldown, which expires at
+--  @triggerTime + cooldownDuration@.
+paydayHandleCooldowns ::
+    forall m.
+    (BlockStateOperations m, MonadProtocolVersion m, IsConsensusV1 (MPV m)) =>
+    -- | The trigger time of the previous epoch.
+    Timestamp ->
+    -- | The current cooldown parameters.
+    CooldownParameters (ChainParametersVersionFor (MPV m)) ->
+    UpdatableBlockState m ->
+    m (UpdatableBlockState m)
+paydayHandleCooldowns = case sSupportsFlexibleCooldown (sAccountVersionFor (protocolVersion @(MPV m))) of
+    SFalse -> \triggerTime _ theState0 -> do
+        bsoProcessPendingChanges theState0 (<= triggerTime)
+    STrue -> \triggerTime cooldownParams theState0 -> do
+        let cooldownTime = triggerTime `addDurationSeconds` (cooldownParams ^. cpUnifiedCooldown)
+        bsoProcessCooldowns theState0 triggerTime cooldownTime
+
 -- | Update the state to reflect an epoch transition.  If the block is not the first in a new epoch
 --  then this does nothing.  Otherwise, it makes the following changes:
 --
@@ -142,7 +169,7 @@ data PrologueResult m = PrologueResult
 --  a catastrophic invariant violation.
 doEpochTransition ::
     forall m.
-    (BlockStateOperations m, IsConsensusV1 (MPV m)) =>
+    (BlockStateOperations m, MonadProtocolVersion m, IsConsensusV1 (MPV m)) =>
     -- | Whether the block is the first in a new epoch
     Bool ->
     -- | The epoch duration
@@ -175,9 +202,13 @@ doEpochTransition True epochDuration theState0 = do
                 theState3 <- bsoSetPaydayMintRate theState2 (timeParams ^. tpMintPerPayday)
                 let newPayday = nextPayday + rewardPeriodEpochs (timeParams ^. tpRewardPeriodLength)
                 theState4 <- bsoSetPaydayEpoch theState3 newPayday
-                -- Process bakers and delegators where the cooldown elapsed by the trigger block
-                -- time of the previous epoch.
-                theState5 <- bsoProcessPendingChanges theState4 (<= oldSeedState ^. triggerBlockTime)
+                -- Process accounts with cooldowns that elapse by the trigger block time of the
+                -- previous epoch, and (in P7 onwards) move pre-cooldowns on accounts into cooldown.
+                theState5 <-
+                    paydayHandleCooldowns
+                        (oldSeedState ^. triggerBlockTime)
+                        (chainParams ^. cpCooldownParameters)
+                        theState4
                 return (theState5, Just paydayParams, newPayday)
             else return (theState0, Nothing, nextPayday)
     -- Update the seed state.
@@ -189,8 +220,9 @@ doEpochTransition True epochDuration theState0 = do
             then do
                 -- This is the start of the last epoch of a payday, so take a baker snapshot.
                 let epochEnd = newSeedState ^. triggerBlockTime
+                let av = accountVersionFor (demoteProtocolVersion (protocolVersion @(MPV m)))
                 (activeBakers, passiveDelegators) <-
-                    applyPendingChanges (<= epochEnd)
+                    applyPendingChanges av (<= epochEnd)
                         <$> bsoGetActiveBakersAndDelegators theState7
                 let BakerStakesAndCapital{..} =
                         computeBakerStakesAndCapital
@@ -203,7 +235,12 @@ doEpochTransition True epochDuration theState0 = do
                         bakerStakes
                         (chainParams ^. cpFinalizationCommitteeParameters)
                 capDist <- capitalDistributionM
-                bsoSetNextCapitalDistribution theState8 capDist
+                theState9 <- bsoSetNextCapitalDistribution theState8 capDist
+                -- From P7 onwards, we transition pre-pre-cooldowns into pre-cooldowns, so that
+                -- at the next payday they will enter cooldown.
+                case sSupportsFlexibleCooldown (sAccountVersionFor (protocolVersion @(MPV m))) of
+                    STrue -> bsoProcessPrePreCooldowns theState9
+                    SFalse -> return theState9
             else return theState7
     return (mPaydayParams, theState9)
 
@@ -237,6 +274,7 @@ executeBlockPrologue ::
     ( pv ~ MPV m,
       BlockStateStorage m,
       BlockState m ~ PBS.HashedPersistentBlockState pv,
+      MonadProtocolVersion m,
       IsConsensusV1 pv
     ) =>
     BlockExecutionData pv ->
diff --git a/concordium-consensus/src/Concordium/Kontrol/Bakers.hs b/concordium-consensus/src/Concordium/Kontrol/Bakers.hs
index 28b986c73..ba97eea22 100644
--- a/concordium-consensus/src/Concordium/Kontrol/Bakers.hs
+++ b/concordium-consensus/src/Concordium/Kontrol/Bakers.hs
@@ -81,11 +81,11 @@ delegatedCapitalCap poolParams totalCap bakerCap delCap = min leverageCap boundC
     PoolCaps{..} = delegatedCapitalCaps poolParams totalCap bakerCap delCap
 
 -- | Process a set of bakers and delegators to apply pending changes that are effective.
-applyPendingChanges ::
+applyPendingChangesP4 ::
     (Timestamp -> Bool) ->
     ([ActiveBakerInfo' bakerInfoRef], [ActiveDelegatorInfo]) ->
     ([ActiveBakerInfo' bakerInfoRef], [ActiveDelegatorInfo])
-applyPendingChanges isEffective (bakers0, passive0) =
+applyPendingChangesP4 isEffective (bakers0, passive0) =
     foldr
         processBaker
         ([], processDelegators passive0)
@@ -124,6 +124,15 @@ applyPendingChanges isEffective (bakers0, passive0) =
       where
         pDelegators = processDelegators activeBakerDelegators
 
+applyPendingChanges ::
+    AccountVersion ->
+    (Timestamp -> Bool) ->
+    ([ActiveBakerInfo' bakerInfoRef], [ActiveDelegatorInfo]) ->
+    ([ActiveBakerInfo' bakerInfoRef], [ActiveDelegatorInfo])
+applyPendingChanges av
+    | supportsFlexibleCooldown av = \_ infos -> infos
+    | otherwise = applyPendingChangesP4
+
 -- | Compute the timestamp of the start of an epoch based on the genesis data.
 epochTimestamp :: GenesisConfiguration -> Epoch -> Timestamp
 epochTimestamp gd targetEpoch =
@@ -200,9 +209,11 @@ computeBakerStakesAndCapital poolParams activeBakers passiveDelegators = BakerSt
 
 -- | Generate and set the next epoch bakers and next capital based on the current active bakers.
 generateNextBakers ::
+    forall m.
     ( TreeStateMonad m,
       PVSupportsDelegation (MPV m),
-      ChainParametersVersionFor (MPV m) ~ 'ChainParametersV1
+      ChainParametersVersionFor (MPV m) ~ 'ChainParametersV1,
+      SupportsFlexibleCooldown (AccountVersionFor (MPV m)) ~ 'False
     ) =>
     -- | The payday epoch
     Epoch ->
@@ -214,7 +225,7 @@ generateNextBakers paydayEpoch bs0 = do
     -- stake reductions that are currently pending on active bakers with effective time at
     -- or before the next payday.
     (activeBakers, passiveDelegators) <-
-        applyPendingChanges isEffective
+        applyPendingChangesP4 isEffective
             <$> bsoGetActiveBakersAndDelegators bs0
     -- Note that we use the current value of the pool parameters as of this block.
     -- This should account for any updates that are effective at or before this block.
@@ -311,9 +322,11 @@ timeParametersAtSlot targetSlot tp0 upds =
 getSlotBakersP4 ::
     forall m.
     ( BlockStateQuery m,
+      MonadProtocolVersion m,
       PVSupportsDelegation (MPV m),
       ChainParametersVersionFor (MPV m) ~ 'ChainParametersV1,
-      SeedStateVersionFor (MPV m) ~ 'SeedStateVersion0
+      SeedStateVersionFor (MPV m) ~ 'SeedStateVersion0,
+      SupportsFlexibleCooldown (AccountVersionFor (MPV m)) ~ 'False
     ) =>
     GenesisConfiguration ->
     BlockState m ->
@@ -364,7 +377,7 @@ getSlotBakersP4 genData bs slot =
                             -- stake reductions that are currently pending on active bakers with effective time at
                             -- or before the next payday.
                             (activeBakers, passiveDelegators) <-
-                                applyPendingChanges isEffective
+                                applyPendingChangesP4 isEffective
                                     <$> getActiveBakersAndDelegators bs
                             -- Determine the pool parameters that would be effective the epoch before the payday
                             pendingPoolParams <- getPendingPoolParameters bs
@@ -391,7 +404,7 @@ getSlotBakersP4 genData bs slot =
 --  The given slot should never be earlier than the slot of the given block.
 getSlotBakers ::
     forall m.
-    ( IsProtocolVersion (MPV m),
+    ( MonadProtocolVersion m,
       BlockStateQuery m,
       ConsensusParametersVersionFor (ChainParametersVersionFor (MPV m)) ~ 'ConsensusParametersVersion0
     ) =>
diff --git a/concordium-consensus/src/Concordium/Scheduler/TreeStateEnvironment.hs b/concordium-consensus/src/Concordium/Scheduler/TreeStateEnvironment.hs
index 6c5403d87..a75f2c99a 100644
--- a/concordium-consensus/src/Concordium/Scheduler/TreeStateEnvironment.hs
+++ b/concordium-consensus/src/Concordium/Scheduler/TreeStateEnvironment.hs
@@ -1087,7 +1087,8 @@ updateBirkParameters newSeedState bs0 oldChainParameters updates = case protocol
     updateCPV1AccountV1 ::
         ( PVSupportsDelegation (MPV m),
           ChainParametersVersionFor (MPV m) ~ 'ChainParametersV1,
-          SeedStateVersionFor (MPV m) ~ 'SeedStateVersion0
+          SeedStateVersionFor (MPV m) ~ 'SeedStateVersion0,
+          SupportsFlexibleCooldown (AccountVersionFor (MPV m)) ~ 'False
         ) =>
         m (MintRewardParams 'ChainParametersV1, UpdatableBlockState m)
     updateCPV1AccountV1 = do

From 953d0702b69042f7843b93e6cd73309791a11dce Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Mon, 10 Jun 2024 17:43:38 +0200
Subject: [PATCH 16/81] Update base

---
 concordium-base | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/concordium-base b/concordium-base
index 5763aef2b..e8485ffb3 160000
--- a/concordium-base
+++ b/concordium-base
@@ -1 +1 @@
-Subproject commit 5763aef2b7ee0ded747dfe081e47a9f2789cfe87
+Subproject commit e8485ffb34fae30028bc32add776b62fc45584ba

From f335fd1a079c72af1ca05a4d4818c2726853045e Mon Sep 17 00:00:00 2001
From: Emil B <eb@concordium.com>
Date: Mon, 24 Jun 2024 10:38:57 +0200
Subject: [PATCH 17/81] Work on configure baker and delegator in P7.

---
 .../GlobalState/Persistent/Account.hs         |  15 +
 .../Persistent/Account/StructureV1.hs         |  40 ++
 .../GlobalState/Persistent/BlockState.hs      | 354 ++++++++++++++----
 .../src/Concordium/Scheduler.hs               |   5 +-
 4 files changed, 344 insertions(+), 70 deletions(-)

diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs
index 5b4553ac6..ef350e8cb 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs
@@ -399,6 +399,14 @@ addAccountBakerV1 binfo amt restake (PAV1 acc) = PAV1 <$> V0.addBakerV1 binfo am
 addAccountBakerV1 binfo amt restake (PAV2 acc) = PAV2 <$> V1.addBakerV1 binfo amt restake acc
 addAccountBakerV1 binfo amt restake (PAV3 acc) = PAV3 <$> V1.addBakerV1 binfo amt restake acc
 
+-- | Add a baker to an account for account version 1.
+--  This will replace any existing staking information on the account.
+removeAccountStake ::
+    (MonadBlobStore m, SupportsFlexibleCooldown av ~ 'True) =>
+    PersistentAccount av ->
+    m (PersistentAccount av)
+removeAccountStake (PAV3 acc) = PAV3 <$> V1.removeStake acc
+
 -- | Add a delegator to an account.
 --  This will replace any existing staking information on the account.
 addAccountDelegator ::
@@ -446,6 +454,13 @@ setAccountStake newStake (PAV1 acc) = PAV1 <$> V0.setStake newStake acc
 setAccountStake newStake (PAV2 acc) = PAV2 <$> V1.setStake newStake acc
 setAccountStake newStake (PAV3 acc) = PAV3 <$> V1.setStake newStake acc
 
+addAccountPrePreCooldown ::
+    (MonadBlobStore m, SupportsFlexibleCooldown av ~ 'True) =>
+    Amount ->
+    PersistentAccount av ->
+    m (PersistentAccount av)
+addAccountPrePreCooldown amt (PAV3 acc) = PAV3 <$> V1.addPrePreCooldown amt acc
+
 -- | Set whether a baker or delegator account restakes its earnings.
 --  This MUST only be called with an account that is either a baker or delegator.
 setAccountRestakeEarnings ::
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
index e7418c286..1f0dd8ccf 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
@@ -32,6 +32,7 @@ import Concordium.Types.Accounts
 import Concordium.Types.Accounts.Releases
 import Concordium.Types.Execution
 import Concordium.Types.HashableTo
+import Concordium.Types.Option
 import Concordium.Types.Parameters
 import Concordium.Utils
 
@@ -1214,6 +1215,23 @@ addBakerV1 binfo stake restake acc = do
               accountEnduringData = newEnduring
             }
 
+-- | Remove a baker/delegator from an account for account version 1.
+--  This will replace any existing staking information on the account.
+removeStake ::
+    (MonadBlobStore m, IsAccountVersion av, AccountStructureVersionFor av ~ 'AccountStructureV1) =>
+    -- | Account to add baker to
+    PersistentAccount av ->
+    m (PersistentAccount av)
+removeStake acc = do
+    let ed = enduringData acc
+    let baker = PersistentAccountStakeEnduringNone
+    newEnduring <- refMake =<< rehashAccountEnduringData ed{paedStake = baker}
+    return $!
+        acc
+            { accountStakedAmount = 0,
+              accountEnduringData = newEnduring
+            }
+
 -- | Add a delegator to an account.
 --  This will replace any existing staking information on the account.
 addDelegator ::
@@ -1297,6 +1315,28 @@ setStake ::
     m (PersistentAccount av)
 setStake newStake acc = return $! acc{accountStakedAmount = newStake}
 
+addPrePreCooldown ::
+    forall m av.
+    ( MonadBlobStore m,
+      IsAccountVersion av,
+      AccountStructureVersionFor av ~ 'AccountStructureV1,
+      SupportsFlexibleCooldown av ~ 'True
+    ) =>
+    Amount ->
+    PersistentAccount av ->
+    m (PersistentAccount av)
+addPrePreCooldown amt = updateEnduringData $ \ed -> do
+    let oldCooldown = paedStakeCooldown ed
+    let newCooldowns = case oldCooldown of
+            EmptyCooldownQueue -> emptyCooldowns{prePreCooldown = Present amt}
+            CooldownQueue ref ->
+                let old = eagerBufferedDeref ref
+                    oldPrePreCooldown = prePreCooldown old
+                    newPrePreCooldown = Present $ ofOption amt (+ amt) oldPrePreCooldown
+                in  old{prePreCooldown = newPrePreCooldown}
+    newRef <- refMake $! newCooldowns
+    return $! ed{paedStakeCooldown = CooldownQueue newRef}
+
 -- | Set whether a baker or delegator account restakes its earnings.
 --  This MUST only be called with an account that is either a baker or delegator.
 setRestakeEarnings ::
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
index 593345223..2fb2d68f0 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
@@ -47,6 +47,7 @@ import Concordium.GlobalState.BakerInfo
 import Concordium.GlobalState.BlockState
 import Concordium.GlobalState.CapitalDistribution
 import qualified Concordium.GlobalState.ContractStateV1 as StateV1
+import qualified Concordium.GlobalState.CooldownQueue as CooldownQueue
 import Concordium.GlobalState.Parameters
 import Concordium.GlobalState.Persistent.Account
 import qualified Concordium.GlobalState.Persistent.Account.MigrationState as MigrationState
@@ -82,6 +83,7 @@ import Concordium.Types.Execution (DelegationTarget (..), TransactionIndex, Tran
 import qualified Concordium.Types.Execution as Transactions
 import Concordium.Types.HashableTo
 import qualified Concordium.Types.IdentityProviders as IPS
+import Concordium.Types.Option
 import Concordium.Types.Queries (
     ActiveBakerPoolStatus (..),
     BakerPoolStatus (..),
@@ -1537,71 +1539,71 @@ doConfigureBaker pbs ai BakerConfigureAdd{..} = do
             let capitalMin = poolParams ^. ppMinimumEquityCapital
             let ranges = poolParams ^. ppCommissionBounds
             if
-                | bcaCapital < capitalMin -> return (BCStakeUnderThreshold, pbs)
-                | not (isInRange bcaTransactionFeeCommission (ranges ^. transactionCommissionRange)) ->
-                    return (BCTransactionFeeCommissionNotInRange, pbs)
-                | not (isInRange bcaBakingRewardCommission (ranges ^. bakingCommissionRange)) ->
-                    return (BCBakingRewardCommissionNotInRange, pbs)
-                | not (isInRange bcaFinalizationRewardCommission (ranges ^. finalizationCommissionRange)) ->
-                    return (BCFinalizationRewardCommissionNotInRange, pbs)
-                | otherwise -> do
-                    let bid = BakerId ai
-                    pab <- refLoad (_birkActiveBakers (bspBirkParameters bsp))
-                    let updAgg Nothing = return (True, Trie.Insert ())
-                        updAgg (Just ()) = return (False, Trie.NoChange)
-                    Trie.adjust updAgg (bkuAggregationKey bcaKeys) (_aggregationKeys pab) >>= \case
-                        -- Aggregation key is a duplicate
-                        (False, _) -> return (BCDuplicateAggregationKey (bkuAggregationKey bcaKeys), pbs)
-                        (True, newAggregationKeys) -> do
-                            newActiveBakers <- Trie.insert bid emptyPersistentActiveDelegators (_activeBakers pab)
-                            newpabref <-
-                                refMake
-                                    PersistentActiveBakers
-                                        { _aggregationKeys = newAggregationKeys,
-                                          _activeBakers = newActiveBakers,
-                                          _passiveDelegators = pab ^. passiveDelegators,
-                                          _totalActiveCapital = addActiveCapital bcaCapital (_totalActiveCapital pab)
-                                        }
-                            let newBirkParams = bspBirkParameters bsp & birkActiveBakers .~ newpabref
-                            let cr =
-                                    CommissionRates
-                                        { _finalizationCommission = bcaFinalizationRewardCommission,
-                                          _bakingCommission = bcaBakingRewardCommission,
-                                          _transactionCommission = bcaTransactionFeeCommission
-                                        }
-                                poolInfo =
-                                    BaseAccounts.BakerPoolInfo
-                                        { _poolOpenStatus = bcaOpenForDelegation,
-                                          _poolMetadataUrl = bcaMetadataURL,
-                                          _poolCommissionRates = cr
-                                        }
-                                bakerInfo = bakerKeyUpdateToInfo bid bcaKeys
-                                bakerInfoEx =
-                                    BaseAccounts.BakerInfoExV1
-                                        { _bieBakerPoolInfo = poolInfo,
-                                          _bieBakerInfo = bakerInfo
-                                        }
-                                updAcc = addAccountBakerV1 bakerInfoEx bcaCapital bcaRestakeEarnings
-                            -- This cannot fail to update the account, since we already looked up the account.
-                            newAccounts <- Accounts.updateAccountsAtIndex' updAcc ai (bspAccounts bsp)
-                            (BCSuccess [] bid,)
-                                <$> storePBS
-                                    pbs
-                                    bsp
-                                        { bspBirkParameters = newBirkParams,
-                                          bspAccounts = newAccounts
-                                        }
+                    | bcaCapital < capitalMin -> return (BCStakeUnderThreshold, pbs)
+                    | not (isInRange bcaTransactionFeeCommission (ranges ^. transactionCommissionRange)) ->
+                        return (BCTransactionFeeCommissionNotInRange, pbs)
+                    | not (isInRange bcaBakingRewardCommission (ranges ^. bakingCommissionRange)) ->
+                        return (BCBakingRewardCommissionNotInRange, pbs)
+                    | not (isInRange bcaFinalizationRewardCommission (ranges ^. finalizationCommissionRange)) ->
+                        return (BCFinalizationRewardCommissionNotInRange, pbs)
+                    | otherwise -> do
+                        let bid = BakerId ai
+                        pab <- refLoad (_birkActiveBakers (bspBirkParameters bsp))
+                        let updAgg Nothing = return (True, Trie.Insert ())
+                            updAgg (Just ()) = return (False, Trie.NoChange)
+                        Trie.adjust updAgg (bkuAggregationKey bcaKeys) (_aggregationKeys pab) >>= \case
+                            -- Aggregation key is a duplicate
+                            (False, _) -> return (BCDuplicateAggregationKey (bkuAggregationKey bcaKeys), pbs)
+                            (True, newAggregationKeys) -> do
+                                newActiveBakers <- Trie.insert bid emptyPersistentActiveDelegators (_activeBakers pab)
+                                newpabref <-
+                                    refMake
+                                        PersistentActiveBakers
+                                            { _aggregationKeys = newAggregationKeys,
+                                              _activeBakers = newActiveBakers,
+                                              _passiveDelegators = pab ^. passiveDelegators,
+                                              _totalActiveCapital = addActiveCapital bcaCapital (_totalActiveCapital pab)
+                                            }
+                                let newBirkParams = bspBirkParameters bsp & birkActiveBakers .~ newpabref
+                                let cr =
+                                        CommissionRates
+                                            { _finalizationCommission = bcaFinalizationRewardCommission,
+                                              _bakingCommission = bcaBakingRewardCommission,
+                                              _transactionCommission = bcaTransactionFeeCommission
+                                            }
+                                    poolInfo =
+                                        BaseAccounts.BakerPoolInfo
+                                            { _poolOpenStatus = bcaOpenForDelegation,
+                                              _poolMetadataUrl = bcaMetadataURL,
+                                              _poolCommissionRates = cr
+                                            }
+                                    bakerInfo = bakerKeyUpdateToInfo bid bcaKeys
+                                    bakerInfoEx =
+                                        BaseAccounts.BakerInfoExV1
+                                            { _bieBakerPoolInfo = poolInfo,
+                                              _bieBakerInfo = bakerInfo
+                                            }
+                                    updAcc = addAccountBakerV1 bakerInfoEx bcaCapital bcaRestakeEarnings
+                                -- This cannot fail to update the account, since we already looked up the account.
+                                newAccounts <- Accounts.updateAccountsAtIndex' updAcc ai (bspAccounts bsp)
+                                (BCSuccess [] bid,)
+                                    <$> storePBS
+                                        pbs
+                                        bsp
+                                            { bspBirkParameters = newBirkParams,
+                                              bspAccounts = newAccounts
+                                            }
 doConfigureBaker pbs ai BakerConfigureUpdate{..} = do
     origBSP <- loadPBS pbs
     cp <- lookupCurrentParameters (bspUpdates origBSP)
     res <- MTL.runExceptT $ MTL.runWriterT $ flip MTL.execStateT origBSP $ do
-        baker <- getAccountOrFail
+        (baker, acc) <- getAccountOrFail
         -- Check the various updates are OK, getting the transformation on the account
         -- implied by each.
         uKeys <- updateKeys baker
         uRestake <- updateRestakeEarnings baker
         uPoolInfo <- updateBakerPoolInfo baker cp
-        uCapital <- updateCapital (sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv))) baker cp
+        uCapital <- updateCapital (sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv))) baker cp acc
         -- Compose together the transformations and apply them to the account.
         let updAcc = uKeys >=> uRestake >=> uPoolInfo >=> uCapital
         modifyAccount' updAcc
@@ -1612,7 +1614,11 @@ doConfigureBaker pbs ai BakerConfigureUpdate{..} = do
     -- Lift a monadic action over the ExceptT, WriterT and StateT layers.
     liftBSO = lift . lift . lift
     bid = BakerId ai
-    getAccountOrFail :: MTL.StateT (BlockStatePointers pv) (MTL.WriterT [BakerConfigureUpdateChange] (MTL.ExceptT BakerConfigureResult m)) (AccountBaker (AccountVersionFor pv))
+    getAccountOrFail ::
+        MTL.StateT
+            (BlockStatePointers pv)
+            (MTL.WriterT [BakerConfigureUpdateChange] (MTL.ExceptT BakerConfigureResult m))
+            (AccountBaker (AccountVersionFor pv), PersistentAccount (AccountVersionFor pv))
     getAccountOrFail = do
         bsp <- MTL.get
         liftBSO (Accounts.indexedAccount ai (bspAccounts bsp)) >>= \case
@@ -1620,7 +1626,7 @@ doConfigureBaker pbs ai BakerConfigureUpdate{..} = do
             Just acc ->
                 accountBaker acc >>= \case
                     Nothing -> MTL.throwError BCInvalidBaker
-                    Just bkr -> return bkr
+                    Just bkr -> return (bkr, acc)
     modifyAccount' updAcc = do
         bsp <- MTL.get
         newAccounts <- liftBSO $ Accounts.updateAccountsAtIndex' updAcc ai (bspAccounts bsp)
@@ -1723,6 +1729,7 @@ doConfigureBaker pbs ai BakerConfigureUpdate{..} = do
         SBool (SupportsFlexibleCooldown (AccountVersionFor pv)) ->
         AccountBaker (AccountVersionFor pv) ->
         ChainParameters' (ChainParametersVersionFor pv) ->
+        PersistentAccount (AccountVersionFor pv) ->
         MTL.StateT
             (BlockStatePointers pv)
             ( MTL.WriterT
@@ -1732,7 +1739,7 @@ doConfigureBaker pbs ai BakerConfigureUpdate{..} = do
             ( PersistentAccount (AccountVersionFor pv) ->
               m (PersistentAccount (AccountVersionFor pv))
             )
-    updateCapital SFalse oldBkr cp = ifPresent bcuCapital $ \capital -> do
+    updateCapital SFalse oldBkr cp _ = ifPresent bcuCapital $ \capital -> do
         when (_bakerPendingChange oldBkr /= BaseAccounts.NoChange) (MTL.throwError BCChangePending)
         let capitalMin = cp ^. cpPoolParameters . ppMinimumEquityCapital
         let cooldownDuration = cp ^. cpCooldownParameters . cpPoolOwnerCooldown
@@ -1764,8 +1771,107 @@ doConfigureBaker pbs ai BakerConfigureUpdate{..} = do
                         MTL.modify' $ \bsp -> bsp{bspBirkParameters = birkParams & birkActiveBakers .~ newActiveBkrs}
                         MTL.tell [BakerConfigureStakeIncreased capital]
                         return $ setAccountStake capital
-    updateCapital STrue oldBkr cp = ifPresent bcuCapital $ \capital -> do
-        undefined
+    updateCapital STrue oldBkr cp acc = ifPresent bcuCapital $ \capital -> do
+        when (_bakerPendingChange oldBkr /= BaseAccounts.NoChange) (MTL.throwError BCChangePending)
+        let capitalMin = cp ^. cpPoolParameters . ppMinimumEquityCapital
+        if capital == 0
+            then do
+                birkParams <- MTL.gets bspBirkParameters
+                activeBkrs <- liftBSO $ refLoad (birkParams ^. birkActiveBakers)
+                (delegators, newActiveBkrs) <- transferDelegatorsToPassive bid activeBkrs
+                newTrie <- Trie.delete bid (newActiveBkrs ^. activeBakers)
+                let newActiveBkrs2 =
+                        newActiveBkrs
+                            & activeBakers .~ newTrie
+                            & totalActiveCapital
+                                %~ subtractActiveCapital (_stakedAmount oldBkr)
+                newActiveBkrsRef <- refMake newActiveBkrs2
+                let notAlreadyInPrePreCooldown = do
+                        accountsInCooldownForPV <- MTL.gets bspAccountsInCooldown
+                        let accountsInCooldown = case theAccountsInCooldownForPV accountsInCooldownForPV of
+                                CTrue accounts -> accounts
+                            oldPrePreCooldowns = prePreCooldown accountsInCooldown
+                        ppRef <- liftBSO $ refMake $ AccountListItem ai oldPrePreCooldowns
+                        let newPrePreCooldowns = Some ppRef
+                            newAccountsInCooldown =
+                                AccountsInCooldownForPV $
+                                    CTrue
+                                        accountsInCooldown{prePreCooldown = newPrePreCooldowns}
+                        MTL.modify' $ \bsp ->
+                            bsp
+                                { bspBirkParameters = birkParams & birkActiveBakers .~ newActiveBkrsRef,
+                                  bspAccountsInCooldown = newAccountsInCooldown
+                                }
+                maybeCooldowns <- accountCooldowns acc
+                case maybeCooldowns of
+                    Nothing -> notAlreadyInPrePreCooldown
+                    Just cooldowns -> case CooldownQueue.prePreCooldown cooldowns of
+                        Absent -> notAlreadyInPrePreCooldown
+                        Present _ ->
+                            MTL.modify' $ \bsp ->
+                                bsp
+                                    { bspBirkParameters = birkParams & birkActiveBakers .~ newActiveBkrsRef
+                                    }
+                accts0 <- MTL.gets bspAccounts
+                accts1 <- foldM redelegatePassive accts0 delegators
+                MTL.modify $ \bsp -> bsp{bspAccounts = accts1}
+                MTL.tell [BakerConfigureStakeReduced 0]
+                return $ removeAccountStake >=> addAccountPrePreCooldown (_stakedAmount oldBkr)
+            else do
+                when (capital < capitalMin) (MTL.throwError BCStakeUnderThreshold)
+                case compare capital (_stakedAmount oldBkr) of
+                    LT -> do
+                        birkParams <- MTL.gets bspBirkParameters
+                        activeBkrs <- liftBSO $ refLoad (birkParams ^. birkActiveBakers)
+                        newActiveBkrs <-
+                            liftBSO $
+                                refMake $
+                                    activeBkrs
+                                        & totalActiveCapital
+                                            %~ subtractActiveCapital (_stakedAmount oldBkr - capital)
+                        let notAlreadyInPrePreCooldown = do
+                                accountsInCooldownForPV <- MTL.gets bspAccountsInCooldown
+                                let accountsInCooldown = case theAccountsInCooldownForPV accountsInCooldownForPV of
+                                        CTrue accounts -> accounts
+                                    oldPrePreCooldowns = prePreCooldown accountsInCooldown
+                                ppRef <- liftBSO $ refMake $ AccountListItem ai oldPrePreCooldowns
+                                let newPrePreCooldowns = Some ppRef
+                                    newAccountsInCooldown =
+                                        AccountsInCooldownForPV $
+                                            CTrue
+                                                accountsInCooldown{prePreCooldown = newPrePreCooldowns}
+                                MTL.modify' $ \bsp ->
+                                    bsp
+                                        { bspBirkParameters = birkParams & birkActiveBakers .~ newActiveBkrs,
+                                          bspAccountsInCooldown = newAccountsInCooldown
+                                        }
+                        maybeCooldowns <- accountCooldowns acc
+                        case maybeCooldowns of
+                            Nothing -> notAlreadyInPrePreCooldown
+                            Just cooldowns -> case CooldownQueue.prePreCooldown cooldowns of
+                                Absent -> notAlreadyInPrePreCooldown
+                                Present _ ->
+                                    MTL.modify' $ \bsp ->
+                                        bsp
+                                            { bspBirkParameters = birkParams & birkActiveBakers .~ newActiveBkrs
+                                            }
+                        MTL.tell [BakerConfigureStakeReduced capital]
+                        return $ setAccountStake capital >=> addAccountPrePreCooldown (_stakedAmount oldBkr - capital)
+                    EQ -> do
+                        MTL.tell [BakerConfigureStakeIncreased capital]
+                        return return
+                    GT -> do
+                        birkParams <- MTL.gets bspBirkParameters
+                        activeBkrs <- liftBSO $ refLoad (birkParams ^. birkActiveBakers)
+                        newActiveBkrs <-
+                            liftBSO $
+                                refMake $
+                                    activeBkrs
+                                        & totalActiveCapital
+                                            %~ addActiveCapital (capital - _stakedAmount oldBkr)
+                        MTL.modify' $ \bsp -> bsp{bspBirkParameters = birkParams & birkActiveBakers .~ newActiveBkrs}
+                        MTL.tell [BakerConfigureStakeIncreased capital]
+                        return $ setAccountStake capital
 
 doConstrainBakerCommission ::
     (SupportsPersistentState pv m, PVSupportsDelegation pv) =>
@@ -1918,7 +2024,7 @@ doConfigureDelegation pbs ai DelegationConfigureUpdate{..} = do
             Nothing -> MTL.throwError DCInvalidAccount
             Just acc ->
                 accountDelegator acc >>= \case
-                    Just del -> return del
+                    Just del -> return (del, acc)
                     Nothing -> MTL.throwError DCInvalidDelegator
     modifyAccount updAcc = do
         bsp <- MTL.get
@@ -1928,7 +2034,7 @@ doConfigureDelegation pbs ai DelegationConfigureUpdate{..} = do
                 { bspAccounts = newAccounts
                 }
     updateDelegationTarget = do
-        acctDlg <- getAccountOrFail
+        (acctDlg, _) <- getAccountOrFail
         let oldTarget = acctDlg ^. BaseAccounts.delegationTarget
         forM_ dcuDelegationTarget $ \target -> do
             unless (oldTarget == target) $ do
@@ -1952,7 +2058,7 @@ doConfigureDelegation pbs ai DelegationConfigureUpdate{..} = do
             MTL.tell [DelegationConfigureDelegationTarget target]
         return oldTarget
     updateRestakeEarnings = forM_ dcuRestakeEarnings $ \restakeEarnings -> do
-        acctDlg <- getAccountOrFail
+        (acctDlg, _) <- getAccountOrFail
         unless (acctDlg ^. BaseAccounts.delegationStakeEarnings == restakeEarnings) $ do
             modifyAccount (setAccountRestakeEarnings restakeEarnings)
         MTL.tell [DelegationConfigureRestakeEarnings restakeEarnings]
@@ -1967,7 +2073,7 @@ doConfigureDelegation pbs ai DelegationConfigureUpdate{..} = do
             )
             Amount
     updateCapital SFalse cp = do
-        ad <- getAccountOrFail
+        (ad, _) <- getAccountOrFail
         forM_ dcuCapital $ \capital -> do
             when (BaseAccounts._delegationPendingChange ad /= BaseAccounts.NoChange) (MTL.throwError DCChangePending)
             -- Cooldown time, used when the change reduces or removes the stake.
@@ -1993,7 +2099,91 @@ doConfigureDelegation pbs ai DelegationConfigureUpdate{..} = do
                         modifyAccount $ setAccountStake capital
                         MTL.tell [DelegationConfigureStakeIncreased capital]
         return $ BaseAccounts._delegationStakedAmount ad
-    updateCapital STrue _ = undefined
+    updateCapital STrue _ = do
+        (ad, acc) <- getAccountOrFail
+        forM_ dcuCapital $ \capital -> do
+            when (BaseAccounts._delegationPendingChange ad /= BaseAccounts.NoChange) (MTL.throwError DCChangePending)
+            -- Cooldown time, used when the change reduces or removes the stake.
+            if capital == 0
+                then do
+                    -- let dpc = BaseAccounts.RemoveStake (BaseAccounts.PendingChangeEffectiveV1 cooldownElapsed)
+                    -- modifyAccount $ setAccountStakePendingChange dpc
+                    bsp1 <- MTL.get
+                    ab <- refLoad (bspBirkParameters bsp1 ^. birkActiveBakers)
+                    newActiveBakers <- removeDelegatorFromActiveBakers ab ad (BaseAccounts._delegationStakedAmount ad - capital)
+                    let notAlreadyInPrePreCooldown = do
+                            accountsInCooldownForPV <- MTL.gets bspAccountsInCooldown
+                            let accountsInCooldown = case theAccountsInCooldownForPV accountsInCooldownForPV of
+                                    CTrue accounts -> accounts
+                                oldPrePreCooldowns = prePreCooldown accountsInCooldown
+                            ppRef <- refMake $ AccountListItem ai oldPrePreCooldowns -- FIXME: why no lift?
+                            let newPrePreCooldowns = Some ppRef
+                                newAccountsInCooldown =
+                                    AccountsInCooldownForPV $
+                                        CTrue
+                                            accountsInCooldown{prePreCooldown = newPrePreCooldowns}
+                            MTL.modify' $ \bsp ->
+                                bsp
+                                    { bspBirkParameters = bspBirkParameters bsp1 & birkActiveBakers .~ newActiveBakers,
+                                      bspAccountsInCooldown = newAccountsInCooldown
+                                    }
+                    maybeCooldowns <- accountCooldowns acc
+                    case maybeCooldowns of
+                        Nothing -> notAlreadyInPrePreCooldown
+                        Just cooldowns -> case CooldownQueue.prePreCooldown cooldowns of
+                            Absent -> notAlreadyInPrePreCooldown
+                            Present _ ->
+                                MTL.modify' $ \bsp ->
+                                    bsp
+                                        { bspBirkParameters = bspBirkParameters bsp1 & birkActiveBakers .~ newActiveBakers
+                                        }
+                    modifyAccount $ removeAccountStake >=> addAccountPrePreCooldown (BaseAccounts._delegationStakedAmount ad)
+                    MTL.tell [DelegationConfigureStakeReduced 0]
+                else case compare capital (BaseAccounts._delegationStakedAmount ad) of
+                    LT -> do
+                        -- let dpc = BaseAccounts.ReduceStake capital (BaseAccounts.PendingChangeEffectiveV1 cooldownElapsed)
+                        -- modifyAccount $ setAccountStakePendingChange dpc
+                        bsp1 <- MTL.get
+                        ab <- refLoad (bspBirkParameters bsp1 ^. birkActiveBakers)
+                        newActiveBakers <- subtractTotalsInActiveBakers ab ad (BaseAccounts._delegationStakedAmount ad - capital)
+                        let notAlreadyInPrePreCooldown = do
+                                accountsInCooldownForPV <- MTL.gets bspAccountsInCooldown
+                                let accountsInCooldown = case theAccountsInCooldownForPV accountsInCooldownForPV of
+                                        CTrue accounts -> accounts
+                                    oldPrePreCooldowns = prePreCooldown accountsInCooldown
+                                ppRef <- refMake $ AccountListItem ai oldPrePreCooldowns
+                                let newPrePreCooldowns = Some ppRef
+                                    newAccountsInCooldown =
+                                        AccountsInCooldownForPV $
+                                            CTrue
+                                                accountsInCooldown{prePreCooldown = newPrePreCooldowns}
+                                MTL.modify' $ \bsp ->
+                                    bsp
+                                        { bspBirkParameters = bspBirkParameters bsp1 & birkActiveBakers .~ newActiveBakers,
+                                          bspAccountsInCooldown = newAccountsInCooldown
+                                        }
+                        maybeCooldowns <- accountCooldowns acc
+                        case maybeCooldowns of
+                            Nothing -> notAlreadyInPrePreCooldown
+                            Just cooldowns -> case CooldownQueue.prePreCooldown cooldowns of
+                                Absent -> notAlreadyInPrePreCooldown
+                                Present _ ->
+                                    MTL.modify' $ \bsp ->
+                                        bsp
+                                            { bspBirkParameters = bspBirkParameters bsp1 & birkActiveBakers .~ newActiveBakers
+                                            }
+                        modifyAccount $ setAccountStake capital >=> addAccountPrePreCooldown (BaseAccounts._delegationStakedAmount ad - capital)
+                        MTL.tell [DelegationConfigureStakeReduced capital]
+                    EQ ->
+                        MTL.tell [DelegationConfigureStakeIncreased capital]
+                    GT -> do
+                        bsp1 <- MTL.get
+                        ab <- refLoad (bspBirkParameters bsp1 ^. birkActiveBakers)
+                        newActiveBakers <- addTotalsInActiveBakers ab ad (capital - BaseAccounts._delegationStakedAmount ad)
+                        MTL.modify' $ \bsp -> bsp{bspBirkParameters = bspBirkParameters bsp1 & birkActiveBakers .~ newActiveBakers}
+                        modifyAccount $ setAccountStake capital
+                        MTL.tell [DelegationConfigureStakeIncreased capital]
+        return $ BaseAccounts._delegationStakedAmount ad
     addTotalsInActiveBakers ab0 ad delta = do
         let ab1 = ab0 & totalActiveCapital %~ addActiveCapital delta
         case ad ^. BaseAccounts.delegationTarget of
@@ -2006,10 +2196,36 @@ doConfigureDelegation pbs ai DelegationConfigureUpdate{..} = do
                     Just (PersistentActiveDelegatorsV1 dset dtot) -> do
                         newActiveMap <- Trie.insert bid (PersistentActiveDelegatorsV1 dset (dtot + delta)) (ab1 ^. activeBakers)
                         refMake $! ab1 & activeBakers .~ newActiveMap
+    subtractTotalsInActiveBakers ab0 ad delta = do
+        let ab1 = ab0 & totalActiveCapital %~ subtractActiveCapital delta
+        case ad ^. BaseAccounts.delegationTarget of
+            Transactions.DelegatePassive -> do
+                let PersistentActiveDelegatorsV1 dset dtot = ab1 ^. passiveDelegators
+                refMake $! ab1 & passiveDelegators .~ PersistentActiveDelegatorsV1 dset (dtot - delta)
+            Transactions.DelegateToBaker bid -> do
+                Trie.lookup bid (ab1 ^. activeBakers) >>= \case
+                    Nothing -> error "Invariant violation: delegation target is not an active baker"
+                    Just (PersistentActiveDelegatorsV1 dset dtot) -> do
+                        newActiveMap <- Trie.insert bid (PersistentActiveDelegatorsV1 dset (dtot - delta)) (ab1 ^. activeBakers)
+                        refMake $! ab1 & activeBakers .~ newActiveMap
+    removeDelegatorFromActiveBakers ab0 ad delta = do
+        let ab1 = ab0 & totalActiveCapital %~ subtractActiveCapital delta
+        case ad ^. BaseAccounts.delegationTarget of
+            Transactions.DelegatePassive -> do
+                let PersistentActiveDelegatorsV1 dset dtot = ab1 ^. passiveDelegators
+                newDelegatorSet <- Trie.delete (ad ^. BaseAccounts.delegationIdentity) dset
+                refMake $! ab1 & passiveDelegators .~ PersistentActiveDelegatorsV1 newDelegatorSet (dtot - delta)
+            Transactions.DelegateToBaker bid -> do
+                Trie.lookup bid (ab1 ^. activeBakers) >>= \case
+                    Nothing -> error "Invariant violation: delegation target is not an active baker"
+                    Just (PersistentActiveDelegatorsV1 dset dtot) -> do
+                        newDelegatorSet <- Trie.delete (ad ^. BaseAccounts.delegationIdentity) dset
+                        newActiveMap <- Trie.insert bid (PersistentActiveDelegatorsV1 newDelegatorSet (dtot - delta)) (ab1 ^. activeBakers)
+                        refMake $! ab1 & activeBakers .~ newActiveMap
     checkOverdelegation oldCapital oldTarget cp = do
         let doCheckOverDelegation = do
                 let pp = cp ^. cpPoolParameters
-                ad <- getAccountOrFail
+                (ad, _) <- getAccountOrFail
                 let target = ad ^. BaseAccounts.delegationTarget
                 bsp <- MTL.get
                 delegationConfigureDisallowOverdelegation bsp pp target
@@ -2279,8 +2495,8 @@ doMint pbs mint = do
             bspBank bsp
                 & unhashed
                     %~ (Rewards.totalGTU +~ mintTotal mint)
-                        . (Rewards.bakingRewardAccount +~ mintBakingReward mint)
-                        . (Rewards.finalizationRewardAccount +~ mintFinalizationReward mint)
+                    . (Rewards.bakingRewardAccount +~ mintBakingReward mint)
+                    . (Rewards.finalizationRewardAccount +~ mintFinalizationReward mint)
     let updAcc = addAccountAmount $ mintDevelopmentCharge mint
     foundationAccount <- (^. cpFoundationAccount) <$> lookupCurrentParameters (bspUpdates bsp)
     newAccounts <- Accounts.updateAccountsAtIndex' updAcc foundationAccount (bspAccounts bsp)
diff --git a/concordium-consensus/src/Concordium/Scheduler.hs b/concordium-consensus/src/Concordium/Scheduler.hs
index bd931a022..54de26c90 100644
--- a/concordium-consensus/src/Concordium/Scheduler.hs
+++ b/concordium-consensus/src/Concordium/Scheduler.hs
@@ -2032,6 +2032,7 @@ data ConfigureDelegationCont
     | ConfigureUpdateDelegationCont
 
 handleConfigureBaker ::
+    forall m.
     ( PVSupportsDelegation (MPV m),
       SchedulerMonad m
     ) =>
@@ -2106,7 +2107,9 @@ handleConfigureBaker
             arg <- case accountStake of
                 AccountStakeNone -> configureAddBakerArg
                 -- FIXME: in new consensus, allow direct switch between baker and delegator.
-                AccountStakeDelegate _ -> rejectTransaction AlreadyADelegator
+                AccountStakeDelegate _ -> case sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor (MPV m))) of
+                    SFalse -> rejectTransaction AlreadyADelegator
+                    STrue -> undefined
                 AccountStakeBaker _ ->
                     configureUpdateBakerArg
             (arg,) <$> getCurrentAccountTotalAmount senderAccount

From 732daf605ccba581701dd205a7d22d0948d2381d Mon Sep 17 00:00:00 2001
From: Emil B <eb@concordium.com>
Date: Mon, 24 Jun 2024 14:44:09 +0200
Subject: [PATCH 18/81] Fix compilation after merge.

---
 .../Persistent/Account/StructureV1.hs            |  2 +-
 .../GlobalState/Persistent/BlockState.hs         | 16 ++++++++--------
 2 files changed, 9 insertions(+), 9 deletions(-)

diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
index fbda0ce9b..f93f8ec15 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
@@ -43,7 +43,7 @@ import qualified Concordium.GlobalState.Basic.BlockState.Account as Transient
 import qualified Concordium.GlobalState.Basic.BlockState.AccountReleaseSchedule as TARS
 import qualified Concordium.GlobalState.Basic.BlockState.AccountReleaseScheduleV1 as TARSV1
 import Concordium.GlobalState.BlockState (AccountAllowance (..))
-import Concordium.GlobalState.CooldownQueue (Cooldowns)
+import Concordium.GlobalState.CooldownQueue (Cooldowns (..), emptyCooldowns)
 import Concordium.GlobalState.Persistent.Account.CooldownQueue as CooldownQueue
 import Concordium.GlobalState.Persistent.Account.EncryptedAmount
 import Concordium.GlobalState.Persistent.Account.MigrationStateInterface
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
index ca622737e..5a87b3b8f 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
@@ -1790,13 +1790,13 @@ doConfigureBaker pbs ai BakerConfigureUpdate{..} = do
                         accountsInCooldownForPV <- MTL.gets bspAccountsInCooldown
                         let accountsInCooldown = case theAccountsInCooldownForPV accountsInCooldownForPV of
                                 CTrue accounts -> accounts
-                            oldPrePreCooldowns = prePreCooldown accountsInCooldown
+                            oldPrePreCooldowns = _prePreCooldown accountsInCooldown
                         ppRef <- liftBSO $ refMake $ AccountListItem ai oldPrePreCooldowns
                         let newPrePreCooldowns = Some ppRef
                             newAccountsInCooldown =
                                 AccountsInCooldownForPV $
                                     CTrue
-                                        accountsInCooldown{prePreCooldown = newPrePreCooldowns}
+                                        accountsInCooldown{_prePreCooldown = newPrePreCooldowns}
                         MTL.modify' $ \bsp ->
                             bsp
                                 { bspBirkParameters = birkParams & birkActiveBakers .~ newActiveBkrsRef,
@@ -1833,13 +1833,13 @@ doConfigureBaker pbs ai BakerConfigureUpdate{..} = do
                                 accountsInCooldownForPV <- MTL.gets bspAccountsInCooldown
                                 let accountsInCooldown = case theAccountsInCooldownForPV accountsInCooldownForPV of
                                         CTrue accounts -> accounts
-                                    oldPrePreCooldowns = prePreCooldown accountsInCooldown
+                                    oldPrePreCooldowns = _prePreCooldown accountsInCooldown
                                 ppRef <- liftBSO $ refMake $ AccountListItem ai oldPrePreCooldowns
                                 let newPrePreCooldowns = Some ppRef
                                     newAccountsInCooldown =
                                         AccountsInCooldownForPV $
                                             CTrue
-                                                accountsInCooldown{prePreCooldown = newPrePreCooldowns}
+                                                accountsInCooldown{_prePreCooldown = newPrePreCooldowns}
                                 MTL.modify' $ \bsp ->
                                     bsp
                                         { bspBirkParameters = birkParams & birkActiveBakers .~ newActiveBkrs,
@@ -2115,13 +2115,13 @@ doConfigureDelegation pbs ai DelegationConfigureUpdate{..} = do
                             accountsInCooldownForPV <- MTL.gets bspAccountsInCooldown
                             let accountsInCooldown = case theAccountsInCooldownForPV accountsInCooldownForPV of
                                     CTrue accounts -> accounts
-                                oldPrePreCooldowns = prePreCooldown accountsInCooldown
+                                oldPrePreCooldowns = _prePreCooldown accountsInCooldown
                             ppRef <- refMake $ AccountListItem ai oldPrePreCooldowns -- FIXME: why no lift?
                             let newPrePreCooldowns = Some ppRef
                                 newAccountsInCooldown =
                                     AccountsInCooldownForPV $
                                         CTrue
-                                            accountsInCooldown{prePreCooldown = newPrePreCooldowns}
+                                            accountsInCooldown{_prePreCooldown = newPrePreCooldowns}
                             MTL.modify' $ \bsp ->
                                 bsp
                                     { bspBirkParameters = bspBirkParameters bsp1 & birkActiveBakers .~ newActiveBakers,
@@ -2150,13 +2150,13 @@ doConfigureDelegation pbs ai DelegationConfigureUpdate{..} = do
                                 accountsInCooldownForPV <- MTL.gets bspAccountsInCooldown
                                 let accountsInCooldown = case theAccountsInCooldownForPV accountsInCooldownForPV of
                                         CTrue accounts -> accounts
-                                    oldPrePreCooldowns = prePreCooldown accountsInCooldown
+                                    oldPrePreCooldowns = _prePreCooldown accountsInCooldown
                                 ppRef <- refMake $ AccountListItem ai oldPrePreCooldowns
                                 let newPrePreCooldowns = Some ppRef
                                     newAccountsInCooldown =
                                         AccountsInCooldownForPV $
                                             CTrue
-                                                accountsInCooldown{prePreCooldown = newPrePreCooldowns}
+                                                accountsInCooldown{_prePreCooldown = newPrePreCooldowns}
                                 MTL.modify' $ \bsp ->
                                     bsp
                                         { bspBirkParameters = bspBirkParameters bsp1 & birkActiveBakers .~ newActiveBakers,

From 96cc0cb339db7b6162586f3004ba8f3330e1dd45 Mon Sep 17 00:00:00 2001
From: Emil B <eb@concordium.com>
Date: Wed, 26 Jun 2024 11:12:20 +0200
Subject: [PATCH 19/81] Release cooldowns on the account when increasing stake.

---
 .../GlobalState/Persistent/Account.hs         |  7 +++
 .../Persistent/Account/StructureV1.hs         | 52 ++++++++++++++++++-
 .../GlobalState/Persistent/BlockState.hs      | 39 +++++++-------
 3 files changed, 78 insertions(+), 20 deletions(-)

diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs
index 3a1ece1e4..cd08f2b24 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs
@@ -461,6 +461,13 @@ addAccountPrePreCooldown ::
     m (PersistentAccount av)
 addAccountPrePreCooldown amt (PAV3 acc) = PAV3 <$> V1.addPrePreCooldown amt acc
 
+releaseCooldownAmount ::
+    (MonadBlobStore m, SupportsFlexibleCooldown av ~ 'True) =>
+    Amount ->
+    PersistentAccount av ->
+    m (PersistentAccount av)
+releaseCooldownAmount amt (PAV3 acc) = PAV3 <$> V1.releaseCooldownAmount amt acc
+
 -- | Set whether a baker or delegator account restakes its earnings.
 --  This MUST only be called with an account that is either a baker or delegator.
 setAccountRestakeEarnings ::
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
index f93f8ec15..2b5819f07 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
@@ -1337,6 +1337,56 @@ addPrePreCooldown amt = updateEnduringData $ \ed -> do
     newRef <- refMake $! newCooldowns
     return $! ed{paedStakeCooldown = CooldownQueue newRef}
 
+releaseCooldownAmount ::
+    forall m av.
+    ( MonadBlobStore m,
+      IsAccountVersion av,
+      AccountStructureVersionFor av ~ 'AccountStructureV1,
+      SupportsFlexibleCooldown av ~ 'True
+    ) =>
+    Amount ->
+    PersistentAccount av ->
+    m (PersistentAccount av)
+releaseCooldownAmount amt = updateEnduringData $ \ed -> do
+    let newCooldowns = case paedStakeCooldown ed of
+            EmptyCooldownQueue -> emptyCooldowns
+            CooldownQueue ref ->
+                let old = eagerBufferedDeref ref
+                    oldPrePreCooldown = prePreCooldown old
+                    (newPrePreCooldown, leftover1) = preHelper amt oldPrePreCooldown
+                    new = old{prePreCooldown = newPrePreCooldown}
+                    oldPreCooldown = preCooldown old
+                    (new2, leftover2) =
+                        if leftover1 > 0
+                            then
+                                let (newPreCooldown, leftover) = preHelper leftover1 oldPreCooldown
+                                in  (new{prePreCooldown = newPreCooldown}, leftover)
+                            else (new, 0)
+                    oldCooldown = inCooldown old
+                    new3 =
+                        if leftover2 > 0
+                            then
+                                let newMap = Map.fromAscList $ releaseHelper leftover2 $ Map.toAscList oldCooldown
+                                in  new2{inCooldown = newMap}
+                            else new2
+                in  new3
+    newRef <- refMake $! newCooldowns
+    return $! ed{paedStakeCooldown = CooldownQueue newRef}
+  where
+    releaseHelper :: Amount -> [(Timestamp, Amount)] -> [(Timestamp, Amount)]
+    releaseHelper left orig@((ts, amount) : cooldowns)
+        | left == 0 = orig
+        | left >= amt = releaseHelper (left - amount) cooldowns
+        | otherwise = (ts, amount - left) : cooldowns
+    releaseHelper _ [] = []
+    preHelper :: Amount -> Option Amount -> (Option Amount, Amount)
+    preHelper left optAmt = case optAmt of
+        Absent -> (Absent, left)
+        Present amount ->
+            if left >= amount
+                then (Absent, left - amount)
+                else (Present (amount - left), 0)
+
 -- | Set whether a baker or delegator account restakes its earnings.
 --  This MUST only be called with an account that is either a baker or delegator.
 setRestakeEarnings ::
@@ -1764,7 +1814,7 @@ migrateV2ToV3 acc = do
         PersistentAccount
             { accountNonce = accountNonce acc,
               accountAmount = accountAmount acc,
-              accountStakedAmount = newStakedAmount, -- FIXME!
+              accountStakedAmount = newStakedAmount,
               ..
             }
 
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
index 5a87b3b8f..37138e6bc 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
@@ -1788,15 +1788,15 @@ doConfigureBaker pbs ai BakerConfigureUpdate{..} = do
                 newActiveBkrsRef <- refMake newActiveBkrs2
                 let notAlreadyInPrePreCooldown = do
                         accountsInCooldownForPV <- MTL.gets bspAccountsInCooldown
-                        let accountsInCooldown = case theAccountsInCooldownForPV accountsInCooldownForPV of
+                        let oldAccountsInCooldown = case theAccountsInCooldownForPV accountsInCooldownForPV of
                                 CTrue accounts -> accounts
-                            oldPrePreCooldowns = _prePreCooldown accountsInCooldown
+                            oldPrePreCooldowns = _prePreCooldown oldAccountsInCooldown
                         ppRef <- liftBSO $ refMake $ AccountListItem ai oldPrePreCooldowns
                         let newPrePreCooldowns = Some ppRef
                             newAccountsInCooldown =
                                 AccountsInCooldownForPV $
                                     CTrue
-                                        accountsInCooldown{_prePreCooldown = newPrePreCooldowns}
+                                        oldAccountsInCooldown{_prePreCooldown = newPrePreCooldowns}
                         MTL.modify' $ \bsp ->
                             bsp
                                 { bspBirkParameters = birkParams & birkActiveBakers .~ newActiveBkrsRef,
@@ -1831,15 +1831,15 @@ doConfigureBaker pbs ai BakerConfigureUpdate{..} = do
                                             %~ subtractActiveCapital (_stakedAmount oldBkr - capital)
                         let notAlreadyInPrePreCooldown = do
                                 accountsInCooldownForPV <- MTL.gets bspAccountsInCooldown
-                                let accountsInCooldown = case theAccountsInCooldownForPV accountsInCooldownForPV of
+                                let oldAccountsInCooldown = case theAccountsInCooldownForPV accountsInCooldownForPV of
                                         CTrue accounts -> accounts
-                                    oldPrePreCooldowns = _prePreCooldown accountsInCooldown
+                                    oldPrePreCooldowns = _prePreCooldown oldAccountsInCooldown
                                 ppRef <- liftBSO $ refMake $ AccountListItem ai oldPrePreCooldowns
                                 let newPrePreCooldowns = Some ppRef
                                     newAccountsInCooldown =
                                         AccountsInCooldownForPV $
                                             CTrue
-                                                accountsInCooldown{_prePreCooldown = newPrePreCooldowns}
+                                                oldAccountsInCooldown{_prePreCooldown = newPrePreCooldowns}
                                 MTL.modify' $ \bsp ->
                                     bsp
                                         { bspBirkParameters = birkParams & birkActiveBakers .~ newActiveBkrs,
@@ -1871,7 +1871,7 @@ doConfigureBaker pbs ai BakerConfigureUpdate{..} = do
                                             %~ addActiveCapital (capital - _stakedAmount oldBkr)
                         MTL.modify' $ \bsp -> bsp{bspBirkParameters = birkParams & birkActiveBakers .~ newActiveBkrs}
                         MTL.tell [BakerConfigureStakeIncreased capital]
-                        return $ setAccountStake capital
+                        return $ setAccountStake capital >=> releaseCooldownAmount (capital - _stakedAmount oldBkr)
 
 doConstrainBakerCommission ::
     (SupportsPersistentState pv m, PVSupportsDelegation pv) =>
@@ -2106,22 +2106,20 @@ doConfigureDelegation pbs ai DelegationConfigureUpdate{..} = do
             -- Cooldown time, used when the change reduces or removes the stake.
             if capital == 0
                 then do
-                    -- let dpc = BaseAccounts.RemoveStake (BaseAccounts.PendingChangeEffectiveV1 cooldownElapsed)
-                    -- modifyAccount $ setAccountStakePendingChange dpc
                     bsp1 <- MTL.get
                     ab <- refLoad (bspBirkParameters bsp1 ^. birkActiveBakers)
                     newActiveBakers <- removeDelegatorFromActiveBakers ab ad (BaseAccounts._delegationStakedAmount ad - capital)
                     let notAlreadyInPrePreCooldown = do
                             accountsInCooldownForPV <- MTL.gets bspAccountsInCooldown
-                            let accountsInCooldown = case theAccountsInCooldownForPV accountsInCooldownForPV of
+                            let oldAccountsInCooldown = case theAccountsInCooldownForPV accountsInCooldownForPV of
                                     CTrue accounts -> accounts
-                                oldPrePreCooldowns = _prePreCooldown accountsInCooldown
+                                oldPrePreCooldowns = _prePreCooldown oldAccountsInCooldown
                             ppRef <- refMake $ AccountListItem ai oldPrePreCooldowns -- FIXME: why no lift?
                             let newPrePreCooldowns = Some ppRef
                                 newAccountsInCooldown =
                                     AccountsInCooldownForPV $
                                         CTrue
-                                            accountsInCooldown{_prePreCooldown = newPrePreCooldowns}
+                                            oldAccountsInCooldown{_prePreCooldown = newPrePreCooldowns}
                             MTL.modify' $ \bsp ->
                                 bsp
                                     { bspBirkParameters = bspBirkParameters bsp1 & birkActiveBakers .~ newActiveBakers,
@@ -2141,22 +2139,20 @@ doConfigureDelegation pbs ai DelegationConfigureUpdate{..} = do
                     MTL.tell [DelegationConfigureStakeReduced 0]
                 else case compare capital (BaseAccounts._delegationStakedAmount ad) of
                     LT -> do
-                        -- let dpc = BaseAccounts.ReduceStake capital (BaseAccounts.PendingChangeEffectiveV1 cooldownElapsed)
-                        -- modifyAccount $ setAccountStakePendingChange dpc
                         bsp1 <- MTL.get
                         ab <- refLoad (bspBirkParameters bsp1 ^. birkActiveBakers)
                         newActiveBakers <- subtractTotalsInActiveBakers ab ad (BaseAccounts._delegationStakedAmount ad - capital)
                         let notAlreadyInPrePreCooldown = do
                                 accountsInCooldownForPV <- MTL.gets bspAccountsInCooldown
-                                let accountsInCooldown = case theAccountsInCooldownForPV accountsInCooldownForPV of
+                                let oldAccountsInCooldown = case theAccountsInCooldownForPV accountsInCooldownForPV of
                                         CTrue accounts -> accounts
-                                    oldPrePreCooldowns = _prePreCooldown accountsInCooldown
+                                    oldPrePreCooldowns = _prePreCooldown oldAccountsInCooldown
                                 ppRef <- refMake $ AccountListItem ai oldPrePreCooldowns
                                 let newPrePreCooldowns = Some ppRef
                                     newAccountsInCooldown =
                                         AccountsInCooldownForPV $
                                             CTrue
-                                                accountsInCooldown{_prePreCooldown = newPrePreCooldowns}
+                                                oldAccountsInCooldown{_prePreCooldown = newPrePreCooldowns}
                                 MTL.modify' $ \bsp ->
                                     bsp
                                         { bspBirkParameters = bspBirkParameters bsp1 & birkActiveBakers .~ newActiveBakers,
@@ -2180,8 +2176,13 @@ doConfigureDelegation pbs ai DelegationConfigureUpdate{..} = do
                         bsp1 <- MTL.get
                         ab <- refLoad (bspBirkParameters bsp1 ^. birkActiveBakers)
                         newActiveBakers <- addTotalsInActiveBakers ab ad (capital - BaseAccounts._delegationStakedAmount ad)
-                        MTL.modify' $ \bsp -> bsp{bspBirkParameters = bspBirkParameters bsp1 & birkActiveBakers .~ newActiveBakers}
-                        modifyAccount $ setAccountStake capital
+                        maybeCooldownsBefore <- accountCooldowns acc
+                        modifyAccount $ setAccountStake capital >=> releaseCooldownAmount capital
+                        maybeCooldownsAfter <- accountCooldowns acc
+                        case (maybeCooldownsBefore, maybeCooldownsAfter) of
+                            (Just _, Nothing) -> do
+                                MTL.modify' $ \bsp -> bsp{bspBirkParameters = bspBirkParameters bsp1 & birkActiveBakers .~ newActiveBakers} -- FIXME: remove cooldown globally here
+                            _ -> MTL.modify' $ \bsp -> bsp{bspBirkParameters = bspBirkParameters bsp1 & birkActiveBakers .~ newActiveBakers}
                         MTL.tell [DelegationConfigureStakeIncreased capital]
         return $ BaseAccounts._delegationStakedAmount ad
     addTotalsInActiveBakers ab0 ad delta = do

From c4f864ec1a4c5894227565165c95a16d9d203c31 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Wed, 26 Jun 2024 17:25:16 +0200
Subject: [PATCH 20/81] Clean-up

---
 .../src/Concordium/GlobalState/Account.hs     | 12 +++--
 .../Basic/BlockState/CooldownQueue.hs         | 48 -------------------
 2 files changed, 8 insertions(+), 52 deletions(-)

diff --git a/concordium-consensus/src/Concordium/GlobalState/Account.hs b/concordium-consensus/src/Concordium/GlobalState/Account.hs
index 7b8ea107b..3544fbbb0 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Account.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Account.hs
@@ -31,6 +31,7 @@ import Concordium.Types.Execution
 import Concordium.Types.HashableTo
 import Concordium.Utils.Serialization
 
+-- | The hash derived from an account's cooldown queue.
 newtype CooldownQueueHash (av :: AccountVersion) = CooldownQueueHash {theCooldownQueueHash :: Hash.Hash}
     deriving (Eq, Ord, Show, Serialize)
 
@@ -252,7 +253,7 @@ data AccountMerkleHashInputs (av :: AccountVersion) where
         { -- | Hash of the persisting account data.
           amhi2PersistingAccountDataHash :: !PersistingAccountDataHash,
           -- | Hash of the account stake.
-          amhi2AccountStakeHash :: !(AccountStakeHash av),
+          amhi2AccountStakeHash :: !(AccountStakeHash 'AccountV2),
           -- | Hash of the account's encrypted amount.
           amhi2EncryptedAmountHash :: !EncryptedAmountHash,
           -- | Hash of the account's release schedule.
@@ -263,13 +264,13 @@ data AccountMerkleHashInputs (av :: AccountVersion) where
         { -- | Hash of the persisting account data.
           amhi3PersistingAccountDataHash :: !PersistingAccountDataHash,
           -- | Hash of the account stake.
-          amhi3AccountStakeHash :: !(AccountStakeHash av),
+          amhi3AccountStakeHash :: !(AccountStakeHash 'AccountV3),
           -- | Hash of the account's encrypted amount.
           amhi3EncryptedAmountHash :: !EncryptedAmountHash,
           -- | Hash of the account's release schedule.
           amhi3AccountReleaseScheduleHash :: !ARSV1.AccountReleaseScheduleHashV1,
-          -- | The cooldown.
-          amhi3Cooldown :: !(CooldownQueueHash av)
+          -- | Hash of the account's cooldown queue.
+          amhi3Cooldown :: !(CooldownQueueHash 'AccountV3)
         } ->
         AccountMerkleHashInputs 'AccountV3
 
@@ -323,6 +324,8 @@ makeAccountHashV2 AccountHashInputsV2{..} = Hash.hashLazy $ runPutLazy $ do
     put ahi2StakedBalance
     put ahi2MerkleHash
 
+-- | Generate the hash for an account (for 'AccountV3'), given the
+--  'AccountHashInputsV2'. 'makeAccountHash' should be used in preference to this function.
 makeAccountHashV3 :: AccountHashInputsV2 av -> Hash.Hash
 makeAccountHashV3 AccountHashInputsV2{..} = Hash.hashLazy $ runPutLazy $ do
     putShortByteString "AC03"
@@ -338,6 +341,7 @@ data AccountHashInputs (av :: AccountVersion) where
     AHIV2 :: AccountHashInputsV2 'AccountV2 -> AccountHashInputs 'AccountV2
     AHIV3 :: AccountHashInputsV2 'AccountV3 -> AccountHashInputs 'AccountV3
 
+-- | Generate the hash for an account, given the 'AccountHashInputs'.
 makeAccountHash :: AccountHashInputs av -> AccountHash av
 {-# INLINE makeAccountHash #-}
 makeAccountHash (AHIV0 ahi) = AccountHash $ makeAccountHashV0 ahi
diff --git a/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/CooldownQueue.hs b/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/CooldownQueue.hs
index e66a41ea7..e2f1a9a6f 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/CooldownQueue.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/CooldownQueue.hs
@@ -111,51 +111,3 @@ processPreCooldown ts (CooldownQueue cdns@Cooldowns{preCooldown = Present newCoo
                 { preCooldown = Absent,
                   inCooldown = Map.alter (Just . (newCooldownAmt +) . fromMaybe 0) ts inCooldown
                 }
-
-{-}
--- | Move all pre-cooldowns into cooldown state. Where the pre-cooldown has a timestamp set, that
--- is used. Otherwise, the timestamp is used. This returns 'Nothing' if the queue would not be
--- changed, i.e. there are no pre-cooldowns.
--- Note, this will predominantly be used when there is at most one pre-cooldown, and it has no
--- timestamp set. Thus, this is not particularly optimized for other cases.
-processPreCooldown :: Timestamp -> Amount -> CooldownQueue av -> Maybe (Amount, CooldownQueue av)
-processPreCooldown _ _ EmptyCooldownQueue = Nothing
-processPreCooldown ts stake (CooldownQueue queue)
-    | null precooldowns = Nothing
-    | tsMillis ts > theCooldownTimeCode maxCooldownTimestampCode = error "Timestamp out of bounds"
-    | otherwise = Just (newStake, newQueue)
-  where
-    newQueue = CooldownQueue $ Map.unionsWith (+) [newCooldowns, preprecooldowns]
-    (cooldowns, rest) = Map.spanAntitone (<= maxCooldownTimestampCode) queue
-    (precooldowns, preprecooldowns) = Map.spanAntitone (<= encodeCooldownTime PreCooldown) rest
-    (newStake, newCooldowns) = Map.foldlWithKey' ff (stake, cooldowns) precooldowns
-    ff (staked, accCooldowns) tc amt
-        | staked == 0 = (staked, accCooldowns)
-        | staked < amt = (staked, accCooldowns)
-        | otherwise = (amt, Map.alter (Just . (+ (staked - amt)) . fromMaybe 0) (f tc) accCooldowns)
-    f c@(CooldownTimeCode code)
-        | c == encodeCooldownTime PreCooldown = CooldownTimeCode $ tsMillis ts
-        | otherwise = CooldownTimeCode (Bits.clearBit code 63)
-
--- | Get the next timestamp (if any) at which a cooldown is scheduled to elapse.
-nextCooldownTime :: CooldownQueue av -> Maybe Timestamp
-nextCooldownTime EmptyCooldownQueue = Nothing
-nextCooldownTime (CooldownQueue queue) = case decodeCooldownTime minEntry of
-    CooldownTimestamp ts -> Just ts
-    _ -> Nothing
-  where
-    -- This is safe because 'CooldownQueue' requires @queue@ to be non-empty.
-    (minEntry, _) = Map.findMin queue
-
--- | Check if a 'CooldownQueue' has any pre-cooldown entries.
-hasPreCooldown :: CooldownQueue av -> Bool
-hasPreCooldown EmptyCooldownQueue = False
-hasPreCooldown (CooldownQueue queue) = case Map.lookupGT maxCooldownTimestampCode queue of
-    Just (x, _) -> x <= encodeCooldownTime PreCooldown
-    Nothing -> False
-
--- | Check if a 'CooldownQueue' has any pre-pre-cooldown entries.
-hasPrePreCooldown :: CooldownQueue av -> Bool
-hasPrePreCooldown EmptyCooldownQueue = False
-hasPrePreCooldown (CooldownQueue queue) = isJust $ Map.lookupGT (encodeCooldownTime PreCooldown) queue
--}

From 3a900f23a66e1fba787f62853e1bdd0a49c80b09 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Thu, 27 Jun 2024 17:29:27 +0200
Subject: [PATCH 21/81] Tests and account storage.

---
 concordium-base                               |   2 +-
 .../Concordium/GlobalState/CooldownQueue.hs   |  12 +-
 .../Persistent/Account/StructureV1.hs         | 103 ++++++++++-----
 .../GlobalStateTests/CooldownQueue.hs         | 117 ++++++++++++++++++
 .../GlobalStateTests/EnduringDataFlags.hs     |  51 +++++---
 .../tests/globalstate/Spec.hs                 |   2 +
 6 files changed, 237 insertions(+), 50 deletions(-)
 create mode 100644 concordium-consensus/tests/globalstate/GlobalStateTests/CooldownQueue.hs

diff --git a/concordium-base b/concordium-base
index 76313e71e..e2e3b24b1 160000
--- a/concordium-base
+++ b/concordium-base
@@ -1 +1 @@
-Subproject commit 76313e71e042d3a7475aa5f5f7b3abaeed2ed30d
+Subproject commit e2e3b24b1a7004d6855d2395b637f5566490d75b
diff --git a/concordium-consensus/src/Concordium/GlobalState/CooldownQueue.hs b/concordium-consensus/src/Concordium/GlobalState/CooldownQueue.hs
index 804aeed8f..f9d935a03 100644
--- a/concordium-consensus/src/Concordium/GlobalState/CooldownQueue.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/CooldownQueue.hs
@@ -108,7 +108,7 @@ processPreCooldown :: Timestamp -> Cooldowns -> Cooldowns
 processPreCooldown _ c@Cooldowns{preCooldown = Absent} = c
 processPreCooldown expiry Cooldowns{preCooldown = Present preAmt, ..} =
     Cooldowns
-        { inCooldown = Map.insert expiry preAmt inCooldown,
+        { inCooldown = Map.insertWith (+) expiry preAmt inCooldown,
           preCooldown = Absent,
           ..
         }
@@ -135,12 +135,20 @@ processPrePreCooldown Cooldowns{preCooldown = Present preAmt, prePreCooldown = P
 firstCooldownTimestamp :: Cooldowns -> Maybe Timestamp
 firstCooldownTimestamp Cooldowns{..} = fst <$> Map.lookupMin inCooldown
 
+-- | Parameters that are used to calculate the timestamps at which stake in pre-cooldown and
+--  pre-pre-cooldown is expected to be released from cooldown.
 data CooldownCalculationParameters = CooldownCalculationParameters
-    { ccpEpochDuration :: Duration,
+    { -- | The duration of an epoch.
+      ccpEpochDuration :: Duration,
+      -- | The current epoch number.
       ccpCurrentEpoch :: Epoch,
+      -- | The time of the next epoch transition (i.e. trigger block time).
       ccpTriggerTime :: Timestamp,
+      -- | The epoch number of the next payday. (Must be after the current epoch.)
       ccpNextPayday :: Epoch,
+      -- | The length of a reward period in epochs.
       ccpRewardPeriodLength :: RewardPeriodLength,
+      -- | The current duration to for cooldowns.
       ccpCooldownDuration :: DurationSeconds
     }
 
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
index 328747cae..335c3abfd 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
@@ -51,6 +51,7 @@ import Concordium.GlobalState.Persistent.BlobStore
 import qualified Concordium.GlobalState.Persistent.BlockState.AccountReleaseSchedule as ARSV0
 import Concordium.GlobalState.Persistent.BlockState.AccountReleaseScheduleV1
 import Concordium.ID.Parameters
+import Data.Bool.Singletons
 
 -- * Terminology
 
@@ -441,12 +442,20 @@ rehashAccountEnduringData = case accountVersion @av of
     SAccountV2 -> rehashAccountEnduringDataAV2
     SAccountV3 -> rehashAccountEnduringDataAV3
 
-enduringDataFlags :: PersistentAccountEnduringData av -> EnduringDataFlags
+enduringDataFlags ::
+    forall av.
+    (IsAccountVersion av) =>
+    PersistentAccountEnduringData av ->
+    EnduringDataFlags av
 enduringDataFlags PersistentAccountEnduringData{..} =
     EnduringDataFlags
         { edHasEncryptedAmount = isNotNull paedEncryptedAmount,
           edHasReleaseSchedule = isNotNull paedReleaseSchedule,
-          edStakeFlags = stakeFlags paedStake paedStakeCooldown
+          edStakeFlags = stakeFlags paedStake,
+          edHasCooldown =
+            conditionally
+                (sSupportsFlexibleCooldown (accountVersion @av))
+                (not $ isCooldownQueueEmpty paedStakeCooldown)
         }
 
 -- * Enduring account data storage helper definitions
@@ -470,10 +479,10 @@ data PendingChangeFlags
     deriving (Eq, Ord, Show)
 
 -- | Get the 'PendingChangeFlags' for a 'StakePendingChange''.
-stakePendingChangeFlags :: StakePendingChange av -> CooldownQueue av -> PendingChangeFlags
-stakePendingChangeFlags NoChange queue = if isCooldownQueueEmpty queue then PendingChangeNone else PendingChangeReduce
-stakePendingChangeFlags ReduceStake{} _ = PendingChangeReduce
-stakePendingChangeFlags RemoveStake{} _ = PendingChangeRemove
+stakePendingChangeFlags :: StakePendingChange av -> PendingChangeFlags
+stakePendingChangeFlags NoChange = PendingChangeNone
+stakePendingChangeFlags ReduceStake{} = PendingChangeReduce
+stakePendingChangeFlags RemoveStake{} = PendingChangeRemove
 
 -- | Store a 'PendingChangeFlags' as the low-order 2 bits of a 'Word8'.
 pendingChangeFlagsToBits :: PendingChangeFlags -> Word8
@@ -495,7 +504,7 @@ pendingChangeFlagsFromBits _ = Left "Invalid pending change type"
 --
 --  - Bits 5 and 4 indicate the staking status of the account:
 --
---    - If bits 5 and 4 are unset, there is no staking. Bit 0 is set if there is stake in cooldown.
+--    - If bits 5 and 4 are unset, there is no staking.
 --      All other bits are unset.
 --
 --    - If bit 5 is unset and bit 4 is set, the account is a baker. In this case
@@ -513,12 +522,11 @@ pendingChangeFlagsFromBits _ = Left "Invalid pending change type"
 --      - Bit 2 is set if earnings are restaked.
 --
 --      - Bits 1 and 0 indicate the pending change as described in 'PendingChangeFlags'.
+--
+--  - If the account version supports flexible cooldown, then bits 1 and 0 are always unset.
 data StakeFlags
     = -- | The account is not staking
       StakeFlagsNone
-        { -- | Whether the stake is in cooldown
-          sfInCooldown :: !Bool
-        }
     | -- | The account is a baker
       StakeFlagsBaker
         { -- | Whether earnings are restaked
@@ -538,26 +546,24 @@ data StakeFlags
     deriving (Eq, Ord, Show)
 
 -- | Get the 'StakeFlags' from a 'PersistentAccountStakeEnduring'.
-stakeFlags :: PersistentAccountStakeEnduring av -> CooldownQueue av -> StakeFlags
-stakeFlags PersistentAccountStakeEnduringNone queue = StakeFlagsNone{sfInCooldown = isCooldownQueueEmpty queue}
-stakeFlags PersistentAccountStakeEnduringBaker{..} queue =
+stakeFlags :: PersistentAccountStakeEnduring av -> StakeFlags
+stakeFlags PersistentAccountStakeEnduringNone = StakeFlagsNone
+stakeFlags PersistentAccountStakeEnduringBaker{..} =
     StakeFlagsBaker
         { sfRestake = paseBakerRestakeEarnings,
-          sfChangeType = stakePendingChangeFlags paseBakerPendingChange queue
+          sfChangeType = stakePendingChangeFlags paseBakerPendingChange
         }
-stakeFlags PersistentAccountStakeEnduringDelegator{..} queue =
+stakeFlags PersistentAccountStakeEnduringDelegator{..} =
     StakeFlagsDelegator
         { sfPassive = DelegatePassive == paseDelegatorTarget,
           sfRestake = paseDelegatorRestakeEarnings,
-          sfChangeType = stakePendingChangeFlags paseDelegatorPendingChange queue
+          sfChangeType = stakePendingChangeFlags paseDelegatorPendingChange
         }
 
 -- | Store a 'StakeFlags' as the low-order 6 bits of a 'Word8'.
 stakeFlagsToBits :: StakeFlags -> Word8
-stakeFlagsToBits StakeFlagsNone{sfInCooldown = False} =
+stakeFlagsToBits StakeFlagsNone =
     0b00_0000
-stakeFlagsToBits StakeFlagsNone{sfInCooldown = True} =
-    0b00_0001
 stakeFlagsToBits StakeFlagsBaker{..} =
     0b01_0000
         .|. (if sfRestake then 0b00_0100 else 0b00_0000)
@@ -571,8 +577,7 @@ stakeFlagsToBits StakeFlagsDelegator{..} =
 -- | Load a 'StakeFlags' from the low-order 6 bits of a 'Word8'.
 --  All other bits must be 0.
 stakeFlagsFromBits :: Word8 -> Either String StakeFlags
-stakeFlagsFromBits 0b00_0000 = return StakeFlagsNone{sfInCooldown = False}
-stakeFlagsFromBits 0b00_0001 = return StakeFlagsNone{sfInCooldown = True}
+stakeFlagsFromBits 0b00_0000 = return StakeFlagsNone
 stakeFlagsFromBits bs = case bs .&. 0b11_0000 of
     0b01_0000 -> do
         when sfPassive $ Left "Passive bit cannot be set for baker"
@@ -593,33 +598,56 @@ stakeFlagsFromBits bs = case bs .&. 0b11_0000 of
 --
 --  - Bit 6 is set if the account has a (non-empty) release schedule.
 --
---  - The remaining bits indicate the staking status of the account, in accordance with 'StakeFlags'.
-data EnduringDataFlags = EnduringDataFlags
+--  - If the account version supports flexible cooldowns, then bit 0 is set if the account has
+--    a cooldown.
+--
+--  - The remaining bits indicate the staking status of the account, in accordance with
+--    'StakeFlags' (where bit 0 is cleared in the case of flexible cooldowns).
+data EnduringDataFlags (av :: AccountVersion) = EnduringDataFlags
     { -- | Whether the enduring data includes a (non-initial) encrypted amount.
       edHasEncryptedAmount :: !Bool,
       -- | Whether the enduring data includes a (non-empty) release schedule.
       edHasReleaseSchedule :: !Bool,
       -- | Flags describing the stake (if any).
-      edStakeFlags :: !StakeFlags
+      edStakeFlags :: !StakeFlags,
+      -- | If supported by the account version, whether the account has a cooldown.
+      edHasCooldown :: !(Conditionally (SupportsFlexibleCooldown av) Bool)
     }
     deriving (Eq, Ord, Show)
 
 -- | Encode an 'EnduringDataFlags' as a 'Word8'.
-enduringDataFlagsToBits :: EnduringDataFlags -> Word8
+enduringDataFlagsToBits :: EnduringDataFlags av -> Word8
 enduringDataFlagsToBits EnduringDataFlags{..} =
     (if edHasEncryptedAmount then 0b1000_0000 else 0b0000_0000)
         .|. (if edHasReleaseSchedule then 0b0100_0000 else 0b0000_0000)
         .|. stakeFlagsToBits edStakeFlags
+        .|. cooldownBits
+  where
+    cooldownBits = case edHasCooldown of
+        CTrue True -> 0b0000_0001
+        _ -> 0b0000_0000
 
 -- | Decode an 'EnduringDataFlags' from a 'Word8'.
-enduringDataFlagsFromBits :: Word8 -> Either String EnduringDataFlags
+enduringDataFlagsFromBits ::
+    forall av.
+    (IsAccountVersion av) =>
+    Word8 ->
+    Either String (EnduringDataFlags av)
 enduringDataFlagsFromBits bs = do
     let edHasEncryptedAmount = testBit bs 7
     let edHasReleaseSchedule = testBit bs 6
-    edStakeFlags <- stakeFlagsFromBits (bs .&. 0b0011_1111)
-    return EnduringDataFlags{..}
-
-instance Serialize EnduringDataFlags where
+    case sSupportsFlexibleCooldown (accountVersion @av) of
+        STrue -> do
+            let edHasCooldown = CTrue (testBit bs 0)
+            when (testBit bs 1) $ Left "Bit 1 must be unset for flexible cooldown"
+            edStakeFlags <- stakeFlagsFromBits (bs .&. 0b0011_1100)
+            return EnduringDataFlags{..}
+        SFalse -> do
+            let edHasCooldown = CFalse
+            edStakeFlags <- stakeFlagsFromBits (bs .&. 0b0011_1111)
+            return EnduringDataFlags{..}
+
+instance (IsAccountVersion av) => Serialize (EnduringDataFlags av) where
     put = putWord8 . enduringDataFlagsToBits
     get = label "EnduringDataFlags" $ do
         bs <- getWord8
@@ -649,13 +677,20 @@ instance Serialize EnduringDataFlags where
 --         - If it is 'PendingChangeNone' then nothing else.
 --         - If it is 'PendingChangeReduce' then the target amount and effective time.
 --         - If it is 'PendingChangeRemove' then the effective time.
+--  7. Depending on 'edHasCooldown':
+--     - If flexible cooldown is supported and the value is @True@, a reference to the
+--       'CooldownQueue'.
+--     - Otherwise, nothing.
 instance (MonadBlobStore m, IsAccountVersion av) => BlobStorable m (PersistentAccountEnduringData av) where
     storeUpdate paed@PersistentAccountEnduringData{..} = do
         (ppd, newPersistingData) <- storeUpdate paedPersistingData
         (pea, newEncryptedAmount) <- storeUpdate paedEncryptedAmount
         (prs, newReleaseSchedule) <- storeUpdate paedReleaseSchedule
         (ps, newStake) <- suStake paedStake
-        (psc, newStakeCooldown) <- storeUpdate paedStakeCooldown
+        (psc, newStakeCooldown) <-
+            if isCooldownQueueEmpty paedStakeCooldown
+                then return (return (), paedStakeCooldown)
+                else storeUpdate paedStakeCooldown
         let p = do
                 put paedHash
                 put flags
@@ -692,7 +727,7 @@ instance (MonadBlobStore m, IsAccountVersion av) => BlobStorable m (PersistentAc
             return $!! (put paseDelegatorId >> ptarget >> ppc, s)
     load = do
         paedHash <- get
-        EnduringDataFlags{..} <- get
+        EnduringDataFlags{..} <- get @(EnduringDataFlags av)
         mPersistingData <- load
         mEncryptedAmount <-
             if edHasEncryptedAmount
@@ -717,7 +752,9 @@ instance (MonadBlobStore m, IsAccountVersion av) => BlobStorable m (PersistentAc
                 paseDelegatorTarget <- if sfPassive then return DelegatePassive else DelegateToBaker <$> get
                 paseDelegatorPendingChange <- getPC sfChangeType
                 return . return $! PersistentAccountStakeEnduringDelegator{..}
-        mStakeCooldown <- load
+        mStakeCooldown <- case edHasCooldown of
+            CTrue True -> load
+            _ -> return (return emptyCooldownQueue)
         return $! do
             paedPersistingData <- mPersistingData
             paedEncryptedAmount <- mEncryptedAmount
diff --git a/concordium-consensus/tests/globalstate/GlobalStateTests/CooldownQueue.hs b/concordium-consensus/tests/globalstate/GlobalStateTests/CooldownQueue.hs
new file mode 100644
index 000000000..9871bbc79
--- /dev/null
+++ b/concordium-consensus/tests/globalstate/GlobalStateTests/CooldownQueue.hs
@@ -0,0 +1,117 @@
+{-# LANGUAGE TypeApplications #-}
+
+module GlobalStateTests.CooldownQueue where
+
+import qualified Data.Map.Strict as Map
+import Data.Serialize
+import Test.HUnit
+import Test.Hspec
+import Test.QuickCheck
+
+import Concordium.Types
+import Concordium.Types.Option
+
+import qualified Concordium.Crypto.SHA256 as Hash
+import Concordium.GlobalState.CooldownQueue
+import Concordium.Types.HashableTo
+
+genCooldowns :: Gen Cooldowns
+genCooldowns = do
+    inCooldown <- Map.fromList <$> listOf (((,) . Timestamp <$> arbitrary) <*> arbitrary)
+    preCooldown <- oneof [return Absent, Present <$> arbitrary]
+    prePreCooldown <- oneof [return Absent, Present <$> arbitrary]
+    return Cooldowns{..}
+
+-- | Test that serializing and deserializing 'Cooldowns' is the identity.
+testSerialize :: Property
+testSerialize = property $ forAll genCooldowns $ \cds -> decode (encode cds) === Right cds
+
+-- | Test that 'isEmptyCooldowns' only holds for the empty cooldowns.
+testIsEmptyCooldowns :: Property
+testIsEmptyCooldowns = property $ forAll genCooldowns $ \cds ->
+    isEmptyCooldowns cds === (cds == emptyCooldowns)
+
+-- | Test that hashing two different cooldowns gives different hashes.
+testHashCooldowns :: Property
+testHashCooldowns = property $ forAll genCooldowns $ \cds1 -> forAll genCooldowns $ \cds2 ->
+    cds1 /= cds2 ==> getHash @Hash.Hash cds1 /= getHash cds2
+
+cooldown1 :: Cooldowns
+cooldown1 =
+    Cooldowns
+        { inCooldown = Map.fromList [(Timestamp 10, 1), (Timestamp 20, 15), (Timestamp 30, 100)],
+          preCooldown = Present 150,
+          prePreCooldown = Present 2000
+        }
+
+cooldown2 :: Cooldowns
+cooldown2 = cooldown1{preCooldown = Absent}
+
+cooldown3 :: Cooldowns
+cooldown3 = cooldown2{prePreCooldown = Absent}
+
+testProcessCooldowns :: Assertion
+testProcessCooldowns = do
+    assertEqual
+        "after 5"
+        cooldown1
+        (processCooldowns 5 cooldown1)
+    assertEqual
+        "after 10"
+        cooldown1{inCooldown = Map.fromList [(Timestamp 20, 15), (Timestamp 30, 100)]}
+        (processCooldowns 10 cooldown1)
+    assertEqual
+        "after 20"
+        cooldown1{inCooldown = Map.fromList [(Timestamp 30, 100)]}
+        (processCooldowns 20 cooldown1)
+    assertEqual
+        "after 25"
+        cooldown1{inCooldown = Map.fromList [(Timestamp 30, 100)]}
+        (processCooldowns 25 cooldown1)
+    assertEqual
+        "after 30"
+        cooldown1{inCooldown = Map.empty}
+        (processCooldowns 30 cooldown1)
+    assertEqual
+        "after 30000"
+        cooldown1{inCooldown = Map.empty}
+        (processCooldowns 30000 cooldown1)
+
+testProcessPreCooldown :: Assertion
+testProcessPreCooldown = do
+    assertEqual "no pre-cooldown" cooldown2 (processPreCooldown 25 cooldown2)
+    assertEqual
+        "at 4000"
+        cooldown2{inCooldown = Map.insert (Timestamp 4000) 150 (inCooldown cooldown1)}
+        (processPreCooldown 4000 cooldown1)
+    assertEqual
+        "at 25"
+        cooldown2{inCooldown = Map.insert (Timestamp 25) 150 (inCooldown cooldown1)}
+        (processPreCooldown 25 cooldown1)
+    assertEqual
+        "at 20"
+        cooldown2{inCooldown = Map.insert (Timestamp 20) 165 (inCooldown cooldown1)}
+        (processPreCooldown 20 cooldown1)
+
+testProcessPrePreCooldown :: Assertion
+testProcessPrePreCooldown = do
+    assertEqual "no pre-pre-cooldown" (processPrePreCooldown cooldown3) cooldown3
+    assertEqual
+        "no pre-cooldown"
+        cooldown2{preCooldown = Present 2000}
+        (processPrePreCooldown (cooldown1{preCooldown = Absent}))
+    assertEqual
+        "with pre-cooldown"
+        cooldown3{preCooldown = Present 2150}
+        (processPrePreCooldown cooldown1)
+
+tests :: Spec
+tests = describe "GlobalStateTests.CooldownQueue" $ parallel $ do
+    it "Cooldowns serialization" $ withMaxSuccess 1000 testSerialize
+    it "Empty cooldowns is empty" $ isEmptyCooldowns emptyCooldowns
+    it "isEmptyCooldowns" testIsEmptyCooldowns
+    it "Hashing cooldowns" $ withMaxSuccess 10000 testHashCooldowns
+    it "cooldownTotal" $ cooldownTotal cooldown1 == 2266
+    it "processCooldowns" testProcessCooldowns
+    it "processPreCooldown" testProcessPreCooldown
+    it "processPrePrecooldown" testProcessPrePreCooldown
diff --git a/concordium-consensus/tests/globalstate/GlobalStateTests/EnduringDataFlags.hs b/concordium-consensus/tests/globalstate/GlobalStateTests/EnduringDataFlags.hs
index f5644c2d8..bd81c16cf 100644
--- a/concordium-consensus/tests/globalstate/GlobalStateTests/EnduringDataFlags.hs
+++ b/concordium-consensus/tests/globalstate/GlobalStateTests/EnduringDataFlags.hs
@@ -1,39 +1,62 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
 -- | This module tests the serialization and deserialization of the 'EnduringDataFlags', which
 --  are used in the persistent storage of accounts from 'P5' onwards.
 module GlobalStateTests.EnduringDataFlags where
 
+import Data.Singletons
 import Test.Hspec
 import Test.QuickCheck
 
+import Concordium.Types
+import Concordium.Types.Conditionally
+
 import Concordium.GlobalState.Persistent.Account.StructureV1
 
 genPendingChangeFlags :: Gen PendingChangeFlags
 genPendingChangeFlags = elements [PendingChangeNone, PendingChangeReduce, PendingChangeRemove]
 
-genStakeFlags :: Gen StakeFlags
-genStakeFlags =
+genStakeFlags :: Bool -> Gen StakeFlags
+genStakeFlags flexCooldown =
     oneof
-        [ StakeFlagsNone <$> arbitrary,
-          StakeFlagsBaker <$> arbitrary <*> genPendingChangeFlags,
-          StakeFlagsDelegator <$> arbitrary <*> arbitrary <*> genPendingChangeFlags
+        [ return StakeFlagsNone,
+          StakeFlagsBaker <$> arbitrary <*> genPCF,
+          StakeFlagsDelegator <$> arbitrary <*> arbitrary <*> genPCF
         ]
-
-genEnduringDataFlags :: Gen EnduringDataFlags
-genEnduringDataFlags = EnduringDataFlags <$> arbitrary <*> arbitrary <*> genStakeFlags
+  where
+    genPCF = if flexCooldown then return PendingChangeNone else genPendingChangeFlags
+
+genEnduringDataFlags ::
+    forall av.
+    (IsAccountVersion av) =>
+    SAccountVersion av ->
+    Gen (EnduringDataFlags av)
+genEnduringDataFlags _ =
+    EnduringDataFlags
+        <$> arbitrary
+        <*> arbitrary
+        <*> genStakeFlags (fromSing $ sSupportsFlexibleCooldown (accountVersion @av))
+        <*> conditionallyA (sSupportsFlexibleCooldown (accountVersion @av)) arbitrary
 
 -- | Test that converting 'EnduringDataFlags' to bits and big is the identity.
-testToFromBits :: Property
-testToFromBits = forAll genEnduringDataFlags $ \edf ->
+testToFromBits :: (IsAccountVersion av) => SAccountVersion av -> Property
+testToFromBits sav = forAll (genEnduringDataFlags sav) $ \edf ->
     Right edf === enduringDataFlagsFromBits (enduringDataFlagsToBits edf)
 
 -- | Test that converting bits to 'EnduringDataFlags' and back is the identity where the first
 --  conversion is well-defined.
-testFromToBits :: Property
-testFromToBits = property $ \bs -> case enduringDataFlagsFromBits bs of
+testFromToBits :: forall av. (IsAccountVersion av) => SAccountVersion av -> Property
+testFromToBits sav = property $ \bs -> case enduringDataFlagsFromBits @av bs of
     Left _ -> property ()
     Right edf -> bs === enduringDataFlagsToBits edf
 
 tests :: Spec
 tests = parallel $ do
-    it "EnduringDataFlags to then from bits" $ withMaxSuccess 10000 testToFromBits
-    it "EnduringDataFlags from then to bits" $ withMaxSuccess 10000 testFromToBits
+    describe "AccountV2" $ avTests SAccountV2
+    describe "AccountV3" $ avTests SAccountV3
+  where
+    avTests :: (IsAccountVersion av) => SAccountVersion av -> Spec
+    avTests sav = do
+        it "EnduringDataFlags to then from bits" $ withMaxSuccess 10000 (testToFromBits sav)
+        it "EnduringDataFlags from then to bits" $ withMaxSuccess 10000 (testFromToBits sav)
diff --git a/concordium-consensus/tests/globalstate/Spec.hs b/concordium-consensus/tests/globalstate/Spec.hs
index ba5abbd1f..11b49943a 100644
--- a/concordium-consensus/tests/globalstate/Spec.hs
+++ b/concordium-consensus/tests/globalstate/Spec.hs
@@ -10,6 +10,7 @@ import qualified GlobalStateTests.AccountsMigrationP6ToP7 (tests)
 import qualified GlobalStateTests.BlobStore (tests)
 import qualified GlobalStateTests.BlockHash (tests)
 import qualified GlobalStateTests.Cache (tests)
+import qualified GlobalStateTests.CooldownQueue (tests)
 import qualified GlobalStateTests.DifferenceMap (tests)
 import qualified GlobalStateTests.EnduringDataFlags (tests)
 import qualified GlobalStateTests.FinalizationSerializationSpec (tests)
@@ -53,3 +54,4 @@ main = atLevel $ \lvl -> hspec $ do
     GlobalStateTests.LMDBAccountMap.tests
     GlobalStateTests.DifferenceMap.tests
     GlobalStateTests.AccountsMigrationP6ToP7.tests
+    GlobalStateTests.CooldownQueue.tests

From bb4dfb178c73a1d7614e6e54daca1a7e6406a8f8 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Fri, 28 Jun 2024 14:00:44 +0200
Subject: [PATCH 22/81] Update base, fix tests.

---
 concordium-base                               |  2 +-
 .../GlobalStateTests/CooldownQueue.hs         | 97 +++++++++++++++++--
 2 files changed, 92 insertions(+), 7 deletions(-)

diff --git a/concordium-base b/concordium-base
index e2e3b24b1..1669eff6c 160000
--- a/concordium-base
+++ b/concordium-base
@@ -1 +1 @@
-Subproject commit e2e3b24b1a7004d6855d2395b637f5566490d75b
+Subproject commit 1669eff6c7fd224727ef6866d7d6d6bb1c8e930e
diff --git a/concordium-consensus/tests/globalstate/GlobalStateTests/CooldownQueue.hs b/concordium-consensus/tests/globalstate/GlobalStateTests/CooldownQueue.hs
index 9871bbc79..89280ae95 100644
--- a/concordium-consensus/tests/globalstate/GlobalStateTests/CooldownQueue.hs
+++ b/concordium-consensus/tests/globalstate/GlobalStateTests/CooldownQueue.hs
@@ -1,5 +1,7 @@
+{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE TypeApplications #-}
 
+-- | This module tests the 'CooldownQueue' structure, and the various functions that operate on it.
 module GlobalStateTests.CooldownQueue where
 
 import qualified Data.Map.Strict as Map
@@ -8,13 +10,15 @@ import Test.HUnit
 import Test.Hspec
 import Test.QuickCheck
 
+import qualified Concordium.Crypto.SHA256 as Hash
 import Concordium.Types
+import Concordium.Types.Accounts
+import Concordium.Types.HashableTo
 import Concordium.Types.Option
 
-import qualified Concordium.Crypto.SHA256 as Hash
 import Concordium.GlobalState.CooldownQueue
-import Concordium.Types.HashableTo
 
+-- | Generate a 'Cooldowns' with arbitrary values.
 genCooldowns :: Gen Cooldowns
 genCooldowns = do
     inCooldown <- Map.fromList <$> listOf (((,) . Timestamp <$> arbitrary) <*> arbitrary)
@@ -36,6 +40,8 @@ testHashCooldowns :: Property
 testHashCooldowns = property $ forAll genCooldowns $ \cds1 -> forAll genCooldowns $ \cds2 ->
     cds1 /= cds2 ==> getHash @Hash.Hash cds1 /= getHash cds2
 
+-- | An example 'Cooldowns' structure with 3 amounts in cooldown, a pre-cooldown of 150, and a
+-- pre-pre-cooldown of 2000.
 cooldown1 :: Cooldowns
 cooldown1 =
     Cooldowns
@@ -44,12 +50,17 @@ cooldown1 =
           prePreCooldown = Present 2000
         }
 
+-- | An example 'Cooldowns' structure with 3 amounts in cooldown, no pre-cooldown, and a
+-- pre-pre-cooldown of 2000.
 cooldown2 :: Cooldowns
 cooldown2 = cooldown1{preCooldown = Absent}
 
+-- | An example 'Cooldowns' structure with 3 amounts in cooldown, no pre-cooldown, and no
+-- pre-pre-cooldown.
 cooldown3 :: Cooldowns
 cooldown3 = cooldown2{prePreCooldown = Absent}
 
+-- | Unit test for 'processCooldowns'.
 testProcessCooldowns :: Assertion
 testProcessCooldowns = do
     assertEqual
@@ -75,8 +86,9 @@ testProcessCooldowns = do
     assertEqual
         "after 30000"
         cooldown1{inCooldown = Map.empty}
-        (processCooldowns 30000 cooldown1)
+        (processCooldowns 30_000 cooldown1)
 
+-- | Unit test for 'processPreCooldown'.
 testProcessPreCooldown :: Assertion
 testProcessPreCooldown = do
     assertEqual "no pre-cooldown" cooldown2 (processPreCooldown 25 cooldown2)
@@ -93,25 +105,98 @@ testProcessPreCooldown = do
         cooldown2{inCooldown = Map.insert (Timestamp 20) 165 (inCooldown cooldown1)}
         (processPreCooldown 20 cooldown1)
 
+-- | Unit test for 'processPrePreCooldown'.
 testProcessPrePreCooldown :: Assertion
 testProcessPrePreCooldown = do
     assertEqual "no pre-pre-cooldown" (processPrePreCooldown cooldown3) cooldown3
     assertEqual
         "no pre-cooldown"
-        cooldown2{preCooldown = Present 2000}
-        (processPrePreCooldown (cooldown1{preCooldown = Absent}))
+        cooldown3{preCooldown = Present 2000}
+        (processPrePreCooldown cooldown2)
     assertEqual
         "with pre-cooldown"
         cooldown3{preCooldown = Present 2150}
         (processPrePreCooldown cooldown1)
 
+-- | Example 'CooldownCalculationParameters' for testing.
+ccp1 :: CooldownCalculationParameters
+ccp1 =
+    CooldownCalculationParameters
+        { ccpEpochDuration = Duration 1000,
+          ccpCurrentEpoch = 10,
+          ccpTriggerTime = Timestamp 1_000_000,
+          ccpNextPayday = 20,
+          ccpRewardPeriodLength = RewardPeriodLength 20,
+          ccpCooldownDuration = DurationSeconds 1000
+        }
+
+-- | Example 'CooldownCalculationParameters' for testing, where the next epoch is a payday.
+ccp2 :: CooldownCalculationParameters
+ccp2 = ccp1{ccpCurrentEpoch = 19}
+
+-- | Test that 'preCooldownTimestamp' calculates the correct timestamp.
+testPreCooldownTimestamp :: Assertion
+testPreCooldownTimestamp = do
+    assertEqual
+        "pre-cooldown timestamp 1"
+        ( 1_000_000 -- Trigger time
+            + 9 * 1000 -- 10 epochs till next payday
+            + 1_000_000 -- Cooldown duration
+        )
+        (preCooldownTimestamp ccp1)
+    assertEqual
+        "pre-cooldown timestamp 2"
+        ( 1_000_000 -- Trigger time
+            + 0 * 1000 -- 1 epoch till next payday
+            + 1_000_000 -- Cooldown duration
+        )
+        (preCooldownTimestamp ccp2)
+
+-- | Test that 'prePreCooldownTimestamp' calculates the correct timestamp.
+testPrePreCooldownTimestamp :: Assertion
+testPrePreCooldownTimestamp = do
+    assertEqual
+        "pre-pre-cooldown timestamp 1"
+        ( 1_000_000 -- Trigger time
+            + 9 * 1000 -- 10 epochs till next payday
+            + 1_000_000 -- Cooldown duration
+        )
+        (prePreCooldownTimestamp ccp1)
+    assertEqual
+        "pre-pre-cooldown timestamp 2"
+        ( 1_000_000 -- Trigger time
+            + 20 * 1000 -- Next epoch is payday; 20 epochs till next payday after that
+            + 1_000_000 -- Cooldown duration
+        )
+        (prePreCooldownTimestamp ccp2)
+
+-- | Unit test for 'toCooldownList'.
+testToCooldownList :: Assertion
+testToCooldownList = do
+    assertEqual
+        "empty cooldowns"
+        []
+        (toCooldownList ccp1 emptyCooldowns)
+    assertEqual
+        "cooldowns"
+        [ Cooldown 10 1 StatusCooldown,
+          Cooldown 20 15 StatusCooldown,
+          Cooldown 30 100 StatusCooldown,
+          Cooldown 2_000_000 150 StatusPreCooldown,
+          Cooldown 2_020_000 2000 StatusPrePreCooldown
+        ]
+        (toCooldownList ccp2 cooldown1)
+
 tests :: Spec
 tests = describe "GlobalStateTests.CooldownQueue" $ parallel $ do
     it "Cooldowns serialization" $ withMaxSuccess 1000 testSerialize
     it "Empty cooldowns is empty" $ isEmptyCooldowns emptyCooldowns
     it "isEmptyCooldowns" testIsEmptyCooldowns
-    it "Hashing cooldowns" $ withMaxSuccess 10000 testHashCooldowns
+    it "Hashing cooldowns" $ withMaxSuccess 10_000 testHashCooldowns
     it "cooldownTotal" $ cooldownTotal cooldown1 == 2266
     it "processCooldowns" testProcessCooldowns
     it "processPreCooldown" testProcessPreCooldown
     it "processPrePrecooldown" testProcessPrePreCooldown
+    it "preCooldownTimestamp" testPreCooldownTimestamp
+    it "prePreCooldownTimestamp" testPrePreCooldownTimestamp
+    it "toCooldownList" testToCooldownList

From 7f873d5741a90f975e291c98f8fe13b68225894e Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Fri, 28 Jun 2024 17:10:40 +0200
Subject: [PATCH 23/81] Fix state hashes in tests.

---
 .../GlobalState/Persistent/Accounts.hs        |  3 +-
 .../KonsensusV1/Consensus/Blocks.hs           | 34 +++++++++----------
 2 files changed, 18 insertions(+), 19 deletions(-)

diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs
index e5945eee4..e03159496 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs
@@ -512,9 +512,8 @@ migrateAccounts migration Accounts{..} = do
     -- that is purely in-memory and just copied over.
     newAccountRegIds <- Trie.migrateUnbufferedTrieN return accountRegIdHistory
     return $!
-        ( Accounts
+        Accounts
             { accountTable = newAccountTable,
               accountRegIdHistory = newAccountRegIds,
               accountDiffMapRef = accountDiffMapRef
             }
-        )
diff --git a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/Consensus/Blocks.hs b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/Consensus/Blocks.hs
index 8c9aadfc6..53dfc6a48 100644
--- a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/Consensus/Blocks.hs
+++ b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/Consensus/Blocks.hs
@@ -300,7 +300,7 @@ testBB1 =
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "6c4e7d2eb2692eef3991a972fd84b6a6f7fdcad37699438362c570f7f60c0ffd"
+                    { dbhv1BlockResultHash = read "0970b0f7459e5150a56ac283eee6f587fc49cb1c3408146b46ee05457235bec7"
                     }
         }
   where
@@ -328,7 +328,7 @@ testBB2 =
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "0d1ee312e4b05a071cfa45e79a4730a8dfbcd6ac939d262e0ba2256c61e718d5"
+                    { dbhv1BlockResultHash = read "2e6636b8275663e44452650e4b7968ecb26a32d57998fbbccc0292fdecb1522d"
                     }
         }
   where
@@ -356,7 +356,7 @@ testBB3 =
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "fd03b1ae16b3cd1d671e6770b9fbb56727b8ef7957dbaad52efdfd826a07de03"
+                    { dbhv1BlockResultHash = read "5777ce2df452ce52ee6beb43c555051588cdad67ad742e7be438cf9d22e31950"
                     }
         }
   where
@@ -377,7 +377,7 @@ testBB2' =
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "132f09cbb3e1dc7d17a50ecebd47bd7ab041e77a0a74796e2f15e2165662b2e9"
+                    { dbhv1BlockResultHash = read "04185ac844f6aea6e32b667debd1e9a337d67a80350d12f1cb813bf212a4bc23"
                     }
         }
   where
@@ -399,7 +399,7 @@ testBB3' =
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "05dfceadaa719c3204b3ac5e1ad2f6ce5e9bbd54e904696280917e7e495b1bd6"
+                    { dbhv1BlockResultHash = read "11e59c1a721359a64b86a0c6bcee8f6cac7c5bc3a6b98517b0b4f8c5a726f9c5"
                     }
         }
   where
@@ -428,7 +428,7 @@ testBB4' =
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "019ae29c33a1a4cdbb6097b58224c0ac5cb4dc0eaea62cf615e2766474dc7be1"
+                    { dbhv1BlockResultHash = read "ad8a288f88806037899d782b7dd3a37ade59e0d5f3e7a90b1db2b722ae9cbe3d"
                     }
         }
   where
@@ -480,7 +480,7 @@ testBB1E =
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "6a1eedbfcdd077bbcb62c65cb4b627530c95963525639fd107ef54972592ab2f"
+                    { dbhv1BlockResultHash = read "1811353ec3811af6241f3e5dc2e19740acf518f02dccc51f427310b8cfe9ca6c"
                     }
         }
   where
@@ -508,7 +508,7 @@ testBB2E =
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "7f71d798c41a33a276416fa60246f35393cd8a081b436c01a0a013694a7779f3"
+                    { dbhv1BlockResultHash = read "99fc52af1ee2336f0d353a84c4d6c15345882271f648f7b84e69d9c40d5571c2"
                     }
         }
   where
@@ -538,7 +538,7 @@ testBB3EX =
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "4bc4b02fa0512059352d4054c08782f17736fb8287f74e952564e2f2dcb7cac0"
+                    { dbhv1BlockResultHash = read "0236b72bafe1575fdde0b01b35d24ad16613569600b83ed46b7e17c3c3dbaf28"
                     }
         }
   where
@@ -584,7 +584,7 @@ testBB3E =
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "9442d3f6be34f90ec8c7fe4ffb6097759d9e0f462f00e05b50b4d1630d0bbdd1"
+                    { dbhv1BlockResultHash = read "2a12a1b02d8cfb835d6f572ffd3a0156145ec2142b47ef7b9e9495b61ff241b7"
                     }
         }
   where
@@ -623,7 +623,7 @@ testBB4E =
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "64fc28137ab6df9b2b78aef5115613a5e8f6ae542c82f1931b13401cd17a1f96"
+                    { dbhv1BlockResultHash = read "66cf8d97a956e2306e60337848775d606f575bd48f4d1e4420d4cf579d5bfb0e"
                     }
         }
   where
@@ -646,7 +646,7 @@ testBB4E' =
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "e862dea1573ec8c64209a71da05ffc7fd4654786bf933cdf300eb81692f99880"
+                    { dbhv1BlockResultHash = read "e0d460456228a923c4d0116b6add192b491279b24ce160067652e1afa11bac56"
                     }
         }
   where
@@ -676,7 +676,7 @@ testBB5E' =
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "175c2ef08169361026461f69b03bab2b4b0e470ef9ddb8cbb3f2a7cf06cc493a"
+                    { dbhv1BlockResultHash = read "2c8ff8fbc07b5e1486ebad3e241fa0aefdb7637651c6120b0a50a27057f7431a"
                     }
         }
   where
@@ -719,7 +719,7 @@ testBB2Ex =
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "13604fd2ea1b003cc98fb1ada3c62af493a608b09dacb70d53b6ca67d18ccc8f"
+                    { dbhv1BlockResultHash = read "a562963223c07cbcee46e78bba06968d578120b71eaf59d8ce12f3f384b21f47"
                     }
         }
   where
@@ -764,7 +764,7 @@ testBB3Ex =
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "64c40bfa061ec21944f37f6b94a2724083e3c3d87d20066e61cdaa4e340fd31d"
+                    { dbhv1BlockResultHash = read "2ea4f556dc29b5a1774635cb670f7b9aa3182eb2cc685b0e4f59daf9541cb539"
                     }
         }
   where
@@ -797,7 +797,7 @@ testBB3EA =
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "7f71d798c41a33a276416fa60246f35393cd8a081b436c01a0a013694a7779f3"
+                    { dbhv1BlockResultHash = read "99fc52af1ee2336f0d353a84c4d6c15345882271f648f7b84e69d9c40d5571c2"
                     }
         }
   where
@@ -830,7 +830,7 @@ testBB4EA =
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "e862dea1573ec8c64209a71da05ffc7fd4654786bf933cdf300eb81692f99880"
+                    { dbhv1BlockResultHash = read "e0d460456228a923c4d0116b6add192b491279b24ce160067652e1afa11bac56"
                     }
         }
   where

From 8e9b6f7ef7f977be71a1b2f3e01d6ba02b201199 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Tue, 9 Jul 2024 11:10:56 +0200
Subject: [PATCH 24/81] Fix hashes in tests.

---
 .../EndToEnd/CredentialDeploymentTests.hs          | 14 +++++++-------
 .../EndToEnd/TransactionTableIntegrationTest.hs    |  8 ++++----
 .../ConcordiumTests/KonsensusV1/CatchUp.hs         |  4 ++--
 3 files changed, 13 insertions(+), 13 deletions(-)

diff --git a/concordium-consensus/tests/consensus/ConcordiumTests/EndToEnd/CredentialDeploymentTests.hs b/concordium-consensus/tests/consensus/ConcordiumTests/EndToEnd/CredentialDeploymentTests.hs
index 0364a4c0d..4c07616e8 100644
--- a/concordium-consensus/tests/consensus/ConcordiumTests/EndToEnd/CredentialDeploymentTests.hs
+++ b/concordium-consensus/tests/consensus/ConcordiumTests/EndToEnd/CredentialDeploymentTests.hs
@@ -101,7 +101,7 @@ testBB1 =
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "26c5ed1dc59b3110601dcf22797d52ca744a332bdd425069acc77326e8adf739"
+                    { dbhv1BlockResultHash = read "dca0b796dbfac96e7043942548c9d7cd470226740e2bdc793107de026d423e8d"
                     }
         }
   where
@@ -130,7 +130,7 @@ testBB2 =
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "b23eb835ac2c975a7e9116590d1a6e5b9b26fe65aeaa7b311760431a189fa20c"
+                    { dbhv1BlockResultHash = read "3812ac3fa24c5676ea40c5879d9e88cd60e8af79d6ad7847c59df0880baacd01"
                     }
         }
   where
@@ -159,7 +159,7 @@ testBB3 =
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "e708da0aeec770abd93544a9717e456712e699e1722fc292c424b8e8fdbbb43d"
+                    { dbhv1BlockResultHash = read "cad9520a6cfac6e3f08a75394d68dcfbb9fa1a857d79e0048be5c7752ca72907"
                     }
         }
   where
@@ -212,7 +212,7 @@ testBB2' =
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "3ee65d909c11c7329694fbbfada2095b7abb8423394122e0d9e97b43cf5d1b4a"
+                    { dbhv1BlockResultHash = read "c97b0cc90e29c62eb0e094696ef38891799360c0a89ad69b418205ab3b15b17a"
                     }
         }
   where
@@ -241,7 +241,7 @@ testBB3' =
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "4ec24c4ad39bce3662a8ce00fc684730df8e96c7c8acda340086826ff08de708"
+                    { dbhv1BlockResultHash = read "f14475f1014ff13d2acf98f56a8f01823c1ae52ae01d53a8004f0e728c538357"
                     }
         }
   where
@@ -268,7 +268,7 @@ testBB4 =
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "cdca4d101170df0990e2624dd2a1bc07b301a9a867f8e0c1d4f8dcc2a60629ee"
+                    { dbhv1BlockResultHash = read "9f757ba3e2fb79512a3c199fbd8b6c0a45eaef0fd3a5cc6a3ca78cf8f7ae18a6"
                     }
         }
   where
@@ -295,7 +295,7 @@ testBB5 =
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "984ba9867ae9574fea5c7f358fb8e365009f298d83e75136231c480b8db45530"
+                    { dbhv1BlockResultHash = read "aca6161199f608947b265a048fd6dc404d31424a2a2a86d42be42310f6fd22a0"
                     }
         }
   where
diff --git a/concordium-consensus/tests/consensus/ConcordiumTests/EndToEnd/TransactionTableIntegrationTest.hs b/concordium-consensus/tests/consensus/ConcordiumTests/EndToEnd/TransactionTableIntegrationTest.hs
index f11096dfd..65c3197a5 100644
--- a/concordium-consensus/tests/consensus/ConcordiumTests/EndToEnd/TransactionTableIntegrationTest.hs
+++ b/concordium-consensus/tests/consensus/ConcordiumTests/EndToEnd/TransactionTableIntegrationTest.hs
@@ -70,7 +70,7 @@ testBB1 =
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "c61642de9fe839abbf378f8e9e56bfd5a2ed744dae5ce82df8dcb9a7849f9ce2"
+                    { dbhv1BlockResultHash = read "796f0c4a934152c4f5a233d5120dbf1dd13370f3499af37c88b4ebf0601983b6"
                     }
         }
   where
@@ -99,7 +99,7 @@ testBB2 =
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "569e1cb324b05d744c3d3f29146c87252e0062f5654278b2e935e92e92778f49"
+                    { dbhv1BlockResultHash = read "c3585a5c1f76d7a8fa587b52c077fce936bd2c6f865afadd50068a61ea52d42e"
                     }
         }
   where
@@ -128,7 +128,7 @@ testBB3 =
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "ce6d3023e834d92e0ac4cde15ed1f20aacab400d1083c98adca13c9ee1b9c426"
+                    { dbhv1BlockResultHash = read "a29f1403de7350e5791d985de61183c093c3e138ff81695908529ff876dbe49d"
                     }
         }
   where
@@ -156,7 +156,7 @@ testBB4 =
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "e40b8cfe9cf6f2f26f1e81783c46dbd4f5de533f9f6a9a789d4849b2ece32b90"
+                    { dbhv1BlockResultHash = read "9c2f41bb1e9ef0636bf67fe35755e2cc56be0c8e9a6e8b41defbdc7d1cdb945b"
                     }
         }
   where
diff --git a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/CatchUp.hs b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/CatchUp.hs
index ab53f5aa7..28621676a 100644
--- a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/CatchUp.hs
+++ b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/CatchUp.hs
@@ -451,7 +451,7 @@ catchupWithTwoBranchesResponse sProtocolVersion =
                                         }
                                 SBlockHashVersion1 ->
                                     DerivableBlockHashesV1
-                                        { dbhv1BlockResultHash = read "58b9be13250f5b498d7590f8cb856a14f547b7028031fb73f3c2018c826a7398"
+                                        { dbhv1BlockResultHash = read "1a40cf446d0ad26c9cebf35e008c37685a3823e33b930b7d5dbbefffae411232"
                                         }
                             }
         TestBlocks.succeedReceiveBlock b4
@@ -586,7 +586,7 @@ testMakeCatchupStatus sProtocolVersion =
                                         }
                                 SBlockHashVersion1 ->
                                     DerivableBlockHashesV1
-                                        { dbhv1BlockResultHash = read "58b9be13250f5b498d7590f8cb856a14f547b7028031fb73f3c2018c826a7398"
+                                        { dbhv1BlockResultHash = read "1a40cf446d0ad26c9cebf35e008c37685a3823e33b930b7d5dbbefffae411232"
                                         }
                             }
         TestBlocks.succeedReceiveBlock b4

From 73d1c26bdcaed7fe33a4f1e0ae1352be14073c2e Mon Sep 17 00:00:00 2001
From: Emil B <eb@concordium.com>
Date: Tue, 9 Jul 2024 13:14:09 +0200
Subject: [PATCH 25/81] More work on configure baker and delegator

---
 .../Persistent/Account/StructureV1.hs         |   4 +-
 .../GlobalState/Persistent/BlockState.hs      | 137 +++++++++++++++++-
 .../GlobalState/Persistent/Cooldown.hs        |  19 +++
 .../GlobalState/Persistent/ReleaseSchedule.hs |  17 +++
 4 files changed, 168 insertions(+), 9 deletions(-)

diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
index 2b5819f07..6f25a1298 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
@@ -1360,7 +1360,7 @@ releaseCooldownAmount amt = updateEnduringData $ \ed -> do
                         if leftover1 > 0
                             then
                                 let (newPreCooldown, leftover) = preHelper leftover1 oldPreCooldown
-                                in  (new{prePreCooldown = newPreCooldown}, leftover)
+                                in  (new{preCooldown = newPreCooldown}, leftover)
                             else (new, 0)
                     oldCooldown = inCooldown old
                     new3 =
@@ -1376,7 +1376,7 @@ releaseCooldownAmount amt = updateEnduringData $ \ed -> do
     releaseHelper :: Amount -> [(Timestamp, Amount)] -> [(Timestamp, Amount)]
     releaseHelper left orig@((ts, amount) : cooldowns)
         | left == 0 = orig
-        | left >= amt = releaseHelper (left - amount) cooldowns
+        | left >= amount = releaseHelper (left - amount) cooldowns
         | otherwise = (ts, amount - left) : cooldowns
     releaseHelper _ [] = []
     preHelper :: Amount -> Option Amount -> (Option Amount, Amount)
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
index 37138e6bc..21cba16de 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
@@ -1586,6 +1586,7 @@ doConfigureBaker pbs ai BakerConfigureAdd{..} = do
                                     updAcc = addAccountBakerV1 bakerInfoEx bcaCapital bcaRestakeEarnings
                                 -- This cannot fail to update the account, since we already looked up the account.
                                 newAccounts <- Accounts.updateAccountsAtIndex' updAcc ai (bspAccounts bsp)
+                                -- FIXME: Here we should release cooldown amounts on the account and globally
                                 (BCSuccess [] bid,)
                                     <$> storePBS
                                         pbs
@@ -1605,8 +1606,9 @@ doConfigureBaker pbs ai BakerConfigureUpdate{..} = do
         uPoolInfo <- updateBakerPoolInfo baker cp
         uCapital <- updateCapital (sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv))) baker cp acc
         -- Compose together the transformations and apply them to the account.
-        let updAcc = uKeys >=> uRestake >=> uPoolInfo >=> uCapital
+        let updAcc = uKeys >=> uRestake >=> uPoolInfo
         modifyAccount' updAcc
+        maybeReleaseCooldownGlobally (sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv))) uCapital acc
     case res of
         Left errorRes -> return (errorRes, pbs)
         Right (newBSP, changes) -> (BCSuccess changes bid,) <$> storePBS pbs newBSP
@@ -1872,6 +1874,77 @@ doConfigureBaker pbs ai BakerConfigureUpdate{..} = do
                         MTL.modify' $ \bsp -> bsp{bspBirkParameters = birkParams & birkActiveBakers .~ newActiveBkrs}
                         MTL.tell [BakerConfigureStakeIncreased capital]
                         return $ setAccountStake capital >=> releaseCooldownAmount (capital - _stakedAmount oldBkr)
+    maybeReleaseCooldownGlobally ::
+        SBool (SupportsFlexibleCooldown (AccountVersionFor pv)) ->
+        (PersistentAccount (AccountVersionFor pv) -> m (PersistentAccount (AccountVersionFor pv))) ->
+        PersistentAccount (AccountVersionFor pv) ->
+        MTL.StateT
+            (BlockStatePointers pv)
+            ( MTL.WriterT
+                [BakerConfigureUpdateChange]
+                (MTL.ExceptT BakerConfigureResult m)
+            )
+            ()
+    maybeReleaseCooldownGlobally SFalse _ _ = return ()
+    maybeReleaseCooldownGlobally STrue upd acc = do
+        maybeCooldownsBefore <- accountCooldowns acc
+        modifyAccount' upd
+        maybeCooldownsAfter <- accountCooldowns acc -- FIXME: We should pass in the updated account heree
+        let (shouldRemovePrePre, shouldRemovePre, shouldRemoveCooldown, shouldUpdateCooldown) =
+                case (maybeCooldownsBefore, maybeCooldownsAfter) of
+                    (Just cd, Nothing) ->
+                        ( isPresent $ CooldownQueue.prePreCooldown cd,
+                          isPresent $ CooldownQueue.preCooldown cd,
+                          Map.lookupMin (CooldownQueue.inCooldown cd),
+                          Nothing
+                        )
+                    (Just cd1, Just cd2) ->
+                        ( isPresent (CooldownQueue.prePreCooldown cd1) && isAbsent (CooldownQueue.prePreCooldown cd2),
+                          isPresent (CooldownQueue.preCooldown cd1) && isPresent (CooldownQueue.preCooldown cd2),
+                          if Map.null (CooldownQueue.inCooldown cd2) then Map.lookupMin (CooldownQueue.inCooldown cd1) else Nothing,
+                          case (Map.lookupMin (CooldownQueue.inCooldown cd1), Map.lookupMin (CooldownQueue.inCooldown cd2)) of
+                            (Just (ts1, _), Just (ts2, _)) -> if ts1 /= ts2 then Just (ts1, ts2) else Nothing
+                            _ -> Nothing
+                        )
+                    _ -> (False, False, Nothing, Nothing)
+        let shouldDo = (shouldRemovePrePre, shouldRemovePre, shouldRemoveCooldown, shouldUpdateCooldown) /= (False, False, Nothing, Nothing)
+        when shouldDo $ do
+            accountsInCooldownForPV <- MTL.gets bspAccountsInCooldown
+            let oldAccountsInCooldown = case theAccountsInCooldownForPV accountsInCooldownForPV of
+                    CTrue accounts -> accounts
+            newAccountsInCooldown1 <-
+                if shouldRemovePrePre
+                    then do
+                        newPrePreCooldown <- removeAccountFromAccountList ai $ _prePreCooldown oldAccountsInCooldown
+                        return oldAccountsInCooldown{_prePreCooldown = newPrePreCooldown}
+                    else return oldAccountsInCooldown
+            newAccountsInCooldown2 <-
+                if shouldRemovePre
+                    then do
+                        newPreCooldown <- removeAccountFromAccountList ai $ _preCooldown oldAccountsInCooldown
+                        return newAccountsInCooldown1{_preCooldown = newPreCooldown}
+                    else return newAccountsInCooldown1
+            newAccountsInCooldown3 <-
+                case shouldRemoveCooldown of
+                    Just (ts, _) -> do
+                        newCooldown <- removeAccountFromReleaseSchedule ts ai $ _cooldown oldAccountsInCooldown
+                        return newAccountsInCooldown2{_cooldown = newCooldown}
+                    Nothing -> return newAccountsInCooldown2
+            newAccountsInCooldown4 <-
+                case shouldUpdateCooldown of
+                    Just (ts1, ts2) -> do
+                        newCooldown <- updateAccountRelease ts1 ts2 ai $ _cooldown oldAccountsInCooldown
+                        return newAccountsInCooldown3{_cooldown = newCooldown}
+                    Nothing -> return newAccountsInCooldown3
+            let newAccountsInCooldownForPV =
+                    AccountsInCooldownForPV $
+                        CTrue newAccountsInCooldown4
+            MTL.modify' $ \bsp ->
+                bsp
+                    { bspAccountsInCooldown = newAccountsInCooldownForPV
+                    }
+
+-- MTL.modify' $ \bsp -> bsp -- FIXME: FIX
 
 doConstrainBakerCommission ::
     (SupportsPersistentState pv m, PVSupportsDelegation pv) =>
@@ -2177,12 +2250,62 @@ doConfigureDelegation pbs ai DelegationConfigureUpdate{..} = do
                         ab <- refLoad (bspBirkParameters bsp1 ^. birkActiveBakers)
                         newActiveBakers <- addTotalsInActiveBakers ab ad (capital - BaseAccounts._delegationStakedAmount ad)
                         maybeCooldownsBefore <- accountCooldowns acc
-                        modifyAccount $ setAccountStake capital >=> releaseCooldownAmount capital
-                        maybeCooldownsAfter <- accountCooldowns acc
-                        case (maybeCooldownsBefore, maybeCooldownsAfter) of
-                            (Just _, Nothing) -> do
-                                MTL.modify' $ \bsp -> bsp{bspBirkParameters = bspBirkParameters bsp1 & birkActiveBakers .~ newActiveBakers} -- FIXME: remove cooldown globally here
-                            _ -> MTL.modify' $ \bsp -> bsp{bspBirkParameters = bspBirkParameters bsp1 & birkActiveBakers .~ newActiveBakers}
+                        modifyAccount $ setAccountStake capital >=> releaseCooldownAmount (capital - BaseAccounts._delegationStakedAmount ad)
+                        maybeCooldownsAfter <- accountCooldowns acc -- FIXME: We should pass in the updated account here
+                        let (shouldRemovePrePre, shouldRemovePre, shouldRemoveCooldown, shouldUpdateCooldown) = case (maybeCooldownsBefore, maybeCooldownsAfter) of
+                                (Just cd, Nothing) ->
+                                    ( isPresent $ CooldownQueue.prePreCooldown cd,
+                                      isPresent $ CooldownQueue.preCooldown cd,
+                                      Map.lookupMin (CooldownQueue.inCooldown cd),
+                                      Nothing
+                                    )
+                                (Just cd1, Just cd2) ->
+                                    ( isPresent (CooldownQueue.prePreCooldown cd1) && isAbsent (CooldownQueue.prePreCooldown cd2),
+                                      isPresent (CooldownQueue.preCooldown cd1) && isPresent (CooldownQueue.preCooldown cd2),
+                                      if Map.null (CooldownQueue.inCooldown cd2) then Map.lookupMin (CooldownQueue.inCooldown cd1) else Nothing,
+                                      case (Map.lookupMin (CooldownQueue.inCooldown cd1), Map.lookupMin (CooldownQueue.inCooldown cd2)) of
+                                        (Just (ts1, _), Just (ts2, _)) -> if ts1 /= ts2 then Just (ts1, ts2) else Nothing
+                                        _ -> Nothing
+                                    ) -- FIXME: refactor this with the stuff in configure baker
+                                _ -> (False, False, Nothing, Nothing)
+                        if (shouldRemovePrePre, shouldRemovePre, shouldRemoveCooldown, shouldUpdateCooldown) == (False, False, Nothing, Nothing)
+                            then MTL.modify' $ \bsp -> bsp{bspBirkParameters = bspBirkParameters bsp1 & birkActiveBakers .~ newActiveBakers}
+                            else do
+                                accountsInCooldownForPV <- MTL.gets bspAccountsInCooldown
+                                let oldAccountsInCooldown = case theAccountsInCooldownForPV accountsInCooldownForPV of
+                                        CTrue accounts -> accounts
+                                newAccountsInCooldown1 <-
+                                    if shouldRemovePrePre
+                                        then do
+                                            newPrePreCooldown <- removeAccountFromAccountList ai $ _prePreCooldown oldAccountsInCooldown
+                                            return oldAccountsInCooldown{_prePreCooldown = newPrePreCooldown}
+                                        else return oldAccountsInCooldown
+                                newAccountsInCooldown2 <-
+                                    if shouldRemovePre
+                                        then do
+                                            newPreCooldown <- removeAccountFromAccountList ai $ _preCooldown oldAccountsInCooldown
+                                            return newAccountsInCooldown1{_preCooldown = newPreCooldown}
+                                        else return newAccountsInCooldown1
+                                newAccountsInCooldown3 <-
+                                    case shouldRemoveCooldown of
+                                        Just (ts, _) -> do
+                                            newCooldown <- removeAccountFromReleaseSchedule ts ai $ _cooldown oldAccountsInCooldown
+                                            return newAccountsInCooldown2{_cooldown = newCooldown}
+                                        Nothing -> return newAccountsInCooldown2
+                                newAccountsInCooldown4 <-
+                                    case shouldUpdateCooldown of
+                                        Just (ts1, ts2) -> do
+                                            newCooldown <- updateAccountRelease ts1 ts2 ai $ _cooldown oldAccountsInCooldown
+                                            return newAccountsInCooldown3{_cooldown = newCooldown}
+                                        Nothing -> return newAccountsInCooldown3
+                                let newAccountsInCooldownForPV =
+                                        AccountsInCooldownForPV $
+                                            CTrue newAccountsInCooldown4
+                                MTL.modify' $ \bsp ->
+                                    bsp
+                                        { bspBirkParameters = bspBirkParameters bsp1 & birkActiveBakers .~ newActiveBakers,
+                                          bspAccountsInCooldown = newAccountsInCooldownForPV
+                                        }
                         MTL.tell [DelegationConfigureStakeIncreased capital]
         return $ BaseAccounts._delegationStakedAmount ad
     addTotalsInActiveBakers ab0 ad delta = do
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Cooldown.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Cooldown.hs
index b626e1b29..826deab55 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Cooldown.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Cooldown.hs
@@ -54,6 +54,25 @@ migrateAccountList (Some ubRef) = do
         newTail <- migrateAccountList (accountListTail ali)
         return $! ali{accountListTail = newTail}
 
+removeAccountFromAccountListItem :: (MonadBlobStore m) => AccountIndex -> AccountListItem -> m AccountList
+removeAccountFromAccountListItem ai alist =
+    if accountListEntry alist == ai
+        then return $ accountListTail alist
+        else case accountListTail alist of
+            Null -> Some <$> refMake alist
+            Some ref -> do
+                alistItem <- refLoad ref
+                newList <- removeAccountFromAccountListItem ai alistItem
+                newRef <- refMake $ AccountListItem (accountListEntry alist) newList
+                return $ Some newRef
+
+removeAccountFromAccountList :: (MonadBlobStore m) => AccountIndex -> AccountList -> m AccountList
+removeAccountFromAccountList ai alist = case alist of
+    Null -> return Null
+    Some ref -> do
+        item <- refLoad ref
+        removeAccountFromAccountListItem ai item
+
 -- | This is an indexing structure and therefore does not need to be hashed. FIXME: add more docs
 data AccountsInCooldown = AccountsInCooldown
     { _cooldown :: !NewReleaseSchedule,
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/ReleaseSchedule.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/ReleaseSchedule.hs
index ac003f4b8..9be4e8cd8 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/ReleaseSchedule.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/ReleaseSchedule.hs
@@ -242,6 +242,23 @@ migrateNewReleaseSchedule rs = do
               nrsMap = newMap
             }
 
+removeAccountFromReleaseSchedule :: (MonadBlobStore m) => Timestamp -> AccountIndex -> NewReleaseSchedule -> m NewReleaseSchedule
+removeAccountFromReleaseSchedule ts ai rs = do
+    (_, nrsMap) <- Trie.adjust remAcc ts (nrsMap rs)
+    newMin <- Trie.findMin nrsMap
+    case newMin of
+        Nothing -> return $! emptyNewReleaseSchedule
+        Just (nrsFirstTimestamp, _) -> return $! NewReleaseSchedule{..}
+  where
+    remAcc Nothing = error "removeAccountFromReleaseSchedule: no entry at expected release time"
+    remAcc (Just (AccountSet accs)) =
+        return $!
+            let accs' = Set.delete ai accs
+            in  if Set.null accs' then ((), Trie.Remove) else ((), Trie.Insert (AccountSet accs'))
+
+updateAccountFromReleaseSchedule :: (MonadBlobStore m) => Timestamp -> Timestamp -> AccountIndex -> NewReleaseSchedule -> m NewReleaseSchedule
+updateAccountFromReleaseSchedule = updateAccountRelease
+
 -- | A reference to an account used in the top-level release schedule.
 --  For protocol version prior to 'P5', this is 'AccountAddress', and for 'P5' onward this is
 --  'AccountIndex'. This type determines the implementation of the release schedule use for the

From b747b488bb5806d6ec3653696fef4979e12f480a Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Tue, 9 Jul 2024 17:53:26 +0200
Subject: [PATCH 26/81] Testing for cooldown processing in block state.

---
 .../GlobalState/Persistent/BlockState.hs      |   5 +-
 .../GlobalState/Persistent/Cooldown.hs        |  43 ++++
 .../src/Concordium/KonsensusV1/Scheduler.hs   |  10 +-
 .../GlobalStateTests/CooldownProcessing.hs    | 188 ++++++++++++++++++
 .../tests/globalstate/Spec.hs                 |   2 +
 5 files changed, 244 insertions(+), 4 deletions(-)
 create mode 100644 concordium-consensus/tests/globalstate/GlobalStateTests/CooldownProcessing.hs

diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
index 5ed0485d8..cd079eaac 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
@@ -37,6 +37,7 @@ module Concordium.GlobalState.Persistent.BlockState (
     cacheStateAndGetTransactionTable,
     migratePersistentBlockState,
     SupportsPersistentState,
+    loadPBS,
 ) where
 
 import qualified Concordium.Crypto.SHA256 as H
@@ -976,6 +977,7 @@ initialPersistentState seedState cryptoParams accounts ips ars keysCollection ch
     initialAmount <- foldM (\sumSoFar account -> (+ sumSoFar) <$> accountAmount account) 0 accounts
     updates <- refMake =<< initialUpdates keysCollection chainParams
     releaseSchedule <- emptyReleaseSchedule
+    acctsInCooldown <- initialAccountsInCooldown accounts
     red <- emptyBlockRewardDetails
     bsp <-
         makeBufferedRef $
@@ -991,7 +993,7 @@ initialPersistentState seedState cryptoParams accounts ips ars keysCollection ch
                   bspTransactionOutcomes = emptyPersistentTransactionOutcomes,
                   bspUpdates = updates,
                   bspReleaseSchedule = releaseSchedule,
-                  bspAccountsInCooldown = emptyAccountsInCooldownForPV,
+                  bspAccountsInCooldown = acctsInCooldown,
                   bspRewardDetails = red
                 }
     bps <- liftIO $ newIORef $! bsp
@@ -1033,6 +1035,7 @@ emptyBlockState bspBirkParameters cryptParams keysCollection chainParams = do
                 }
     liftIO $ newIORef $! bsp
 
+-- | Load 'BlockStatePointers' from a 'PersistentBlockState'.
 loadPBS :: (SupportsPersistentState pv m) => PersistentBlockState pv -> m (BlockStatePointers pv)
 loadPBS = loadBufferedRef <=< liftIO . readIORef
 {-# INLINE loadPBS #-}
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Cooldown.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Cooldown.hs
index b626e1b29..da05fa9d4 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Cooldown.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Cooldown.hs
@@ -7,14 +7,19 @@
 
 module Concordium.GlobalState.Persistent.Cooldown where
 
+import Control.Monad
 import Data.Bool.Singletons
+import qualified Data.Map.Strict as Map
 import Data.Serialize
 import Lens.Micro.Platform
 
+import qualified Concordium.GlobalState.CooldownQueue as CooldownQueue
+import Concordium.GlobalState.Persistent.Account
 import Concordium.GlobalState.Persistent.BlobStore
 import Concordium.GlobalState.Persistent.ReleaseSchedule
 import Concordium.Types
 import Concordium.Types.Conditionally
+import Concordium.Types.Option
 
 -- | An 'AccountIndex' and the (possibly empty) tail of the list.
 data AccountListItem = AccountListItem
@@ -37,6 +42,12 @@ instance (MonadBlobStore m) => BlobStorable m AccountListItem where
 -- | A possibly empty list of 'AccountIndex'es, stored under 'UnbufferedRef's.
 type AccountList = Nullable (UnbufferedRef AccountListItem)
 
+-- | Prepend an 'AccountIndex' to an 'AccountList'.
+consAccountList :: (MonadBlobStore m) => AccountIndex -> AccountList -> m AccountList
+consAccountList accountIndex accountList = do
+    ref <- refMake (AccountListItem accountIndex accountList)
+    return (Some ref)
+
 -- | Load an entire account list. This is intended for testing purposes.
 loadAccountList :: (MonadBlobStore m) => AccountList -> m [AccountIndex]
 loadAccountList Null = return []
@@ -152,6 +163,38 @@ emptyAccountsInCooldownForPV =
 instance (MonadBlobStore m) => Cacheable m (AccountsInCooldownForPV pv) where
     cache = fmap AccountsInCooldownForPV . mapM cache . theAccountsInCooldownForPV
 
+-- | Generate the initial 'AccountsInCooldownForPV' structure from the initial accounts.
+initialAccountsInCooldown ::
+    forall pv m.
+    (MonadBlobStore m, IsProtocolVersion pv) =>
+    [PersistentAccount (AccountVersionFor pv)] ->
+    m (AccountsInCooldownForPV pv)
+initialAccountsInCooldown accounts = case sSupportsFlexibleCooldown sAV of
+    SFalse -> return emptyAccountsInCooldownForPV
+    STrue -> do
+        AccountsInCooldownForPV . CTrue
+            <$> foldM checkAccount emptyAccountsInCooldown (zip [0 ..] accounts)
+  where
+    sAV = accountVersion @(AccountVersionFor pv)
+    checkAccount aic (aid, acct) = do
+        accountCooldowns acct >>= \case
+            Nothing -> return aic
+            Just accCooldowns -> do
+                newCooldown <- case Map.lookupMin (CooldownQueue.inCooldown accCooldowns) of
+                    Nothing -> return $ aic ^. cooldown
+                    Just (ts, _) -> addAccountRelease ts aid (aic ^. cooldown)
+                newPreCooldown <- case CooldownQueue.preCooldown accCooldowns of
+                    Absent -> return $ aic ^. preCooldown
+                    Present _ -> consAccountList aid (aic ^. preCooldown)
+                newPrePreCooldown <- case CooldownQueue.prePreCooldown accCooldowns of
+                    Absent -> return $ aic ^. prePreCooldown
+                    Present _ -> consAccountList aid (aic ^. prePreCooldown)
+                return $
+                    aic
+                        & cooldown .~ newCooldown
+                        & preCooldown .~ newPreCooldown
+                        & prePreCooldown .~ newPrePreCooldown
+
 -- | Migrate an 'AccountsInCooldownForPV'.
 --
 --   * If the new protocol version (@pv@) does not support flexible cooldown, then this just
diff --git a/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs b/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs
index dbd91d2e8..a0a445f79 100644
--- a/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs
+++ b/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs
@@ -156,17 +156,21 @@ paydayHandleCooldowns = case sSupportsFlexibleCooldown (sAccountVersionFor (prot
 --       - Process pending cooldowns on bakers and delegators that were set to elapse by the
 --         trigger block time for the previous epoch.
 --
+--       - (>=P7) Process pre-cooldowns on accounts, moving them into cooldown.
+--
 --   * The seed state is updated to reflect the epoch transition.
 --
 --   * If the new epoch is the epoch before the next payday, take a snapshot of bakers and
---     delegators, allowing for cooldowns that are set to elapse at by the trigger block time for
---     this epoch.
+--     delegators. Prior to protocol version 7, this accounts for cooldowns that are set to elapse
+--     by the trigger block time for this epoch. From protocol version 7, accounts in
+--     pre-pre-cooldown are moved to pre-cooldown.
 --
 --  Note: If the baker or delegator cooldown period is ever less than the duration of an epoch, then
 --  it would be possible to have a baker not in cooldown when the baker snapshot is taken, but be
 --  removed when the cooldowns are processed at the payday. This is bad, because the baker/delegator
 --  would not have their stake locked while they are baking/delegating. However, this should not be
---  a catastrophic invariant violation.
+--  a catastrophic invariant violation. (This does not apply from protocol version 7 onwards, as
+--  cooldowns are processed differently.)
 doEpochTransition ::
     forall m.
     (BlockStateOperations m, MonadProtocolVersion m, IsConsensusV1 (MPV m)) =>
diff --git a/concordium-consensus/tests/globalstate/GlobalStateTests/CooldownProcessing.hs b/concordium-consensus/tests/globalstate/GlobalStateTests/CooldownProcessing.hs
new file mode 100644
index 000000000..65e4a4b75
--- /dev/null
+++ b/concordium-consensus/tests/globalstate/GlobalStateTests/CooldownProcessing.hs
@@ -0,0 +1,188 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+-- | This module tests the processing of cooldowns in the global state.
+--  Specifically, it tests the 'bsoProcessPrePreCooldowns' and 'bsoProcessCooldowns' functions.
+module GlobalStateTests.CooldownProcessing where
+
+import Control.Exception
+import Control.Monad.IO.Class
+import qualified Data.Map.Strict as Map
+import Data.Maybe
+import qualified Data.Set as Set
+import Lens.Micro
+import System.FilePath
+import System.IO.Temp
+import Test.HUnit
+import Test.Hspec
+import Test.QuickCheck
+
+import qualified Concordium.Crypto.SHA256 as Hash
+import Concordium.Types
+import Concordium.Types.Option
+import Concordium.Types.SeedState
+
+import qualified Concordium.GlobalState.AccountMap.LMDB as LMDBAccountMap
+import Concordium.GlobalState.BlockState
+import Concordium.GlobalState.CooldownQueue
+import qualified Concordium.GlobalState.DummyData as DummyData
+import Concordium.GlobalState.Persistent.Account
+import qualified Concordium.GlobalState.Persistent.Account.CooldownQueue as CooldownQueue
+import qualified Concordium.GlobalState.Persistent.Account.StructureV1 as SV1
+import Concordium.GlobalState.Persistent.Accounts
+import Concordium.GlobalState.Persistent.BlobStore
+import Concordium.GlobalState.Persistent.BlockState
+import qualified Concordium.GlobalState.Persistent.BlockState.Modules as Modules
+import qualified Concordium.GlobalState.Persistent.Cooldown as Cooldown
+import qualified Concordium.GlobalState.Persistent.ReleaseSchedule as ReleaseSchedule
+import qualified Concordium.GlobalState.Persistent.Trie as Trie
+import Concordium.Scheduler.DummyData
+
+import GlobalStateTests.Accounts (NoLoggerT (..), runNoLoggerT)
+import GlobalStateTests.CooldownQueue (genCooldowns)
+
+dummyCooldownAccount ::
+    forall av m.
+    (IsAccountVersion av, MonadBlobStore m, AVSupportsFlexibleCooldown av) =>
+    AccountIndex ->
+    Amount ->
+    Cooldowns ->
+    m (PersistentAccount av)
+dummyCooldownAccount ai amt cooldowns = do
+    makeTestAccountFromSeed @av amt (fromIntegral ai) >>= \case
+        PAV3 acc -> do
+            let ed = SV1.enduringData acc
+            cq <- CooldownQueue.makeCooldownQueue cooldowns
+            newEnduring <- refMake =<< SV1.rehashAccountEnduringData ed{SV1.paedStakeCooldown = cq}
+            return $ PAV3 acc{SV1.accountEnduringData = newEnduring}
+
+runTestBlockState ::
+    forall pv a.
+    PersistentBlockStateMonad
+        pv
+        (PersistentBlockStateContext pv)
+        (BlobStoreT (PersistentBlockStateContext pv) (NoLoggerT IO))
+        a ->
+    IO a
+runTestBlockState kont = withTempDirectory "." "blockstate" $ \dir -> do
+    bracket
+        ( do
+            pbscBlobStore <- createBlobStore (dir </> "blockstate.dat")
+            pbscAccountCache <- newAccountCache 100
+            pbscModuleCache <- Modules.newModuleCache 100
+            pbscAccountMap <- LMDBAccountMap.openDatabase (dir </> "accountmap")
+            return PersistentBlockStateContext{..}
+        )
+        ( \PersistentBlockStateContext{..} -> do
+            closeBlobStore pbscBlobStore
+            LMDBAccountMap.closeDatabase pbscAccountMap
+        )
+        (runNoLoggerT . runBlobStoreT (runPersistentBlockStateMonad kont))
+
+-- | Get the 'Cooldowns' for each account, and check that the indexes for cooldowns, pre-cooldowns
+--  and pre-pre-cooldowns are correct.
+checkCooldowns :: (PVSupportsFlexibleCooldown pv, SupportsPersistentState pv m) => PersistentBlockState pv -> m [Cooldowns]
+checkCooldowns pbs = do
+    bsp <- loadPBS pbs
+    (_, theCooldowns, cooldownMap, preCooldowns, prePreCooldowns) <-
+        foldAccounts
+            ( \(!ai, accum, cooldownMap, preCooldowns, prePreCooldowns) pa -> do
+                cd <- fromMaybe emptyCooldowns <$> accountCooldowns pa
+                let newCooldowns = cd : accum
+                let newCooldownMap = case Map.lookupMin (inCooldown cd) of
+                        Nothing -> cooldownMap
+                        Just (ts, _) ->
+                            Map.alter
+                                ( \case
+                                    Nothing -> Just (Set.singleton ai)
+                                    Just s -> Just (Set.insert ai s)
+                                )
+                                ts
+                                cooldownMap
+                let newPreCooldowns = case preCooldown cd of
+                        Absent -> preCooldowns
+                        Present _ -> Set.insert ai preCooldowns
+                let newPrePreCooldowns = case prePreCooldown cd of
+                        Absent -> prePreCooldowns
+                        Present _ -> Set.insert ai prePreCooldowns
+                return (ai + 1, newCooldowns, newCooldownMap, newPreCooldowns, newPrePreCooldowns)
+            )
+            (AccountIndex 0, [], Map.empty, Set.empty, Set.empty)
+            (bspAccounts bsp)
+    let aic = bspAccountsInCooldown bsp ^. Cooldown.accountsInCooldown
+    actualCooldownMap <- Trie.toMap (ReleaseSchedule.nrsMap $ aic ^. Cooldown.cooldown)
+    liftIO $ assertEqual "Cooldown map" cooldownMap (ReleaseSchedule.theAccountSet <$> actualCooldownMap)
+    actualPreCooldowns <- Set.fromList <$> Cooldown.loadAccountList (aic ^. Cooldown.preCooldown)
+    liftIO $ assertEqual "Pre-cooldown set" preCooldowns actualPreCooldowns
+    actualPrePreCooldowns <- Set.fromList <$> Cooldown.loadAccountList (aic ^. Cooldown.prePreCooldown)
+    liftIO $ assertEqual "Pre-pre-cooldown set" prePreCooldowns actualPrePreCooldowns
+    return (reverse theCooldowns)
+
+-- | Test 'bsoProcessCooldowns' with a state where the account cooldowns are as given.
+propProcessPrePreCooldowns :: [Cooldowns] -> Assertion
+propProcessPrePreCooldowns cds = runTestBlockState @P7 $ do
+    let mkAcct (i, cd) = dummyCooldownAccount i (cooldownTotal cd + 1000) cd
+    initialAccts <- mapM mkAcct (zip [0 ..] cds)
+    initialBS <-
+        initialPersistentState
+            (initialSeedStateV1 (Hash.hash "NONCE") 1000)
+            DummyData.dummyCryptographicParameters
+            initialAccts
+            DummyData.dummyIdentityProviders
+            DummyData.dummyArs
+            DummyData.dummyKeyCollection
+            DummyData.dummyChainParameters
+    bs' <- bsoProcessPrePreCooldowns (hpbsPointers initialBS)
+    newCooldowns <- checkCooldowns bs'
+    liftIO $ assertEqual "Cooldowns" (processPrePreCooldown <$> cds) newCooldowns
+
+propProcessCooldowns :: [Cooldowns] -> Timestamp -> Timestamp -> Assertion
+propProcessCooldowns cds expire new = runTestBlockState @P7 $ do
+    let mkAcct (i, cd) = dummyCooldownAccount i (cooldownTotal cd + 1000) cd
+    initialAccts <- mapM mkAcct (zip [0 ..] cds)
+    initialBS <-
+        initialPersistentState
+            (initialSeedStateV1 (Hash.hash "NONCE") 1000)
+            DummyData.dummyCryptographicParameters
+            initialAccts
+            DummyData.dummyIdentityProviders
+            DummyData.dummyArs
+            DummyData.dummyKeyCollection
+            DummyData.dummyChainParameters
+    bs' <- bsoProcessCooldowns (hpbsPointers initialBS) expire new
+    newCooldowns <- checkCooldowns bs'
+    liftIO $ assertEqual "Cooldowns" (processPreCooldown new . processCooldowns expire <$> cds) newCooldowns
+
+-- | Generate a 'Cooldowns' with no pre-cooldown.
+genCooldownsNoPre :: Gen Cooldowns
+genCooldownsNoPre = do
+    cooldown <- genCooldowns
+    return cooldown{preCooldown = Absent}
+
+-- | Test 'bsoProcessPrePreCooldowns'.
+testProcessPrePreCooldowns :: Spec
+testProcessPrePreCooldowns = do
+    it "10 accounts, no cooldowns" $ propProcessPrePreCooldowns (replicate 10 emptyCooldowns)
+    it "5 accounts no cooldowns, 5 accounts with pre-pre-cooldown" $
+        propProcessPrePreCooldowns $
+            replicate 5 emptyCooldowns ++ replicate 5 (emptyCooldowns{prePreCooldown = Present 1000})
+    it "accounts with arbitray cooldowns (but no pre-cooldown)" $
+        forAll (listOf genCooldownsNoPre) propProcessPrePreCooldowns
+
+-- | Test 'bsoProcessCooldowns'.
+testProcessCooldowns :: Spec
+testProcessCooldowns = do
+    it "accounts with arbitrary cooldowns" $
+        forAll (listOf genCooldowns) $ \cds -> do
+            forAll arbitrary $ \expire ->
+                forAll arbitrary $ \new ->
+                    propProcessCooldowns cds (Timestamp expire) (Timestamp new)
+
+tests :: Spec
+tests = describe "CooldownProcessing" $ do
+    describe "bsoProcessPrePreCooldowns" testProcessPrePreCooldowns
+    describe "bsoProcessCooldowns" testProcessCooldowns
diff --git a/concordium-consensus/tests/globalstate/Spec.hs b/concordium-consensus/tests/globalstate/Spec.hs
index 11b49943a..ebaec6075 100644
--- a/concordium-consensus/tests/globalstate/Spec.hs
+++ b/concordium-consensus/tests/globalstate/Spec.hs
@@ -10,6 +10,7 @@ import qualified GlobalStateTests.AccountsMigrationP6ToP7 (tests)
 import qualified GlobalStateTests.BlobStore (tests)
 import qualified GlobalStateTests.BlockHash (tests)
 import qualified GlobalStateTests.Cache (tests)
+import qualified GlobalStateTests.CooldownProcessing (tests)
 import qualified GlobalStateTests.CooldownQueue (tests)
 import qualified GlobalStateTests.DifferenceMap (tests)
 import qualified GlobalStateTests.EnduringDataFlags (tests)
@@ -55,3 +56,4 @@ main = atLevel $ \lvl -> hspec $ do
     GlobalStateTests.DifferenceMap.tests
     GlobalStateTests.AccountsMigrationP6ToP7.tests
     GlobalStateTests.CooldownQueue.tests
+    GlobalStateTests.CooldownProcessing.tests

From 16b5b749ab1b27e607b38e5aa643710c3d705f89 Mon Sep 17 00:00:00 2001
From: Emil B <eb@concordium.com>
Date: Tue, 16 Jul 2024 16:56:58 +0200
Subject: [PATCH 27/81] Also release cooldown when adding baker or delegator.

---
 .../GlobalState/Persistent/Accounts.hs        |   6 +
 .../GlobalState/Persistent/BlockState.hs      | 287 ++++++++++--------
 2 files changed, 173 insertions(+), 120 deletions(-)

diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs
index e5945eee4..5d4c6e573 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs
@@ -420,6 +420,12 @@ updateAccountsAtIndex fupd ai a0@Accounts{..} =
         Nothing -> return (Nothing, a0)
         Just (res, act') -> return (Just res, a0{accountTable = act'})
 
+setAccountAtIndex :: (SupportsPersistentAccount pv m) => AccountIndex -> PersistentAccount (AccountVersionFor pv) -> Accounts pv -> m (Accounts pv)
+setAccountAtIndex ai newAcct a0@Accounts{..} =
+    L.update (const (return ((), newAcct))) ai accountTable >>= \case
+        Nothing -> return a0
+        Just (_, act') -> return (a0{accountTable = act'})
+
 -- | Perform an update to an account with the given index.
 --  Does nothing if the account does not exist.
 --  This should not be used to alter the address of an account (which is
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
index 21cba16de..b730170e6 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
@@ -1533,7 +1533,7 @@ doConfigureBaker pbs ai BakerConfigureAdd{..} = do
     Accounts.indexedAccount ai (bspAccounts bsp) >>= \case
         -- Cannot resolve the account
         Nothing -> return (BCInvalidAccount, pbs)
-        Just _ -> do
+        Just acc -> do
             chainParams <- lookupCurrentParameters (bspUpdates bsp)
             let poolParams = chainParams ^. cpPoolParameters
             let capitalMin = poolParams ^. ppMinimumEquityCapital
@@ -1585,15 +1585,34 @@ doConfigureBaker pbs ai BakerConfigureAdd{..} = do
                                             }
                                     updAcc = addAccountBakerV1 bakerInfoEx bcaCapital bcaRestakeEarnings
                                 -- This cannot fail to update the account, since we already looked up the account.
-                                newAccounts <- Accounts.updateAccountsAtIndex' updAcc ai (bspAccounts bsp)
-                                -- FIXME: Here we should release cooldown amounts on the account and globally
+                                newBSP <- updateAccountsAndMaybeCooldown (sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv))) acc updAcc bcaCapital bsp{bspBirkParameters = newBirkParams}
                                 (BCSuccess [] bid,)
                                     <$> storePBS
                                         pbs
-                                        bsp
-                                            { bspBirkParameters = newBirkParams,
-                                              bspAccounts = newAccounts
-                                            }
+                                        newBSP
+  where
+    updateAccountsAndMaybeCooldown ::
+        SBool (SupportsFlexibleCooldown (AccountVersionFor pv)) ->
+        PersistentAccount (AccountVersionFor pv) ->
+        (PersistentAccount (AccountVersionFor pv) -> m (PersistentAccount (AccountVersionFor pv))) ->
+        Amount ->
+        BlockStatePointers pv ->
+        m (BlockStatePointers pv)
+    updateAccountsAndMaybeCooldown SFalse _ updAcc _ bsp = do
+        newAccounts <- Accounts.updateAccountsAtIndex' updAcc ai (bspAccounts bsp)
+        return bsp{bspAccounts = newAccounts}
+    updateAccountsAndMaybeCooldown STrue acc updAcc capital bsp = do
+        maybeCooldownsBefore <- accountCooldowns acc
+        newAcc <- (updAcc >=> releaseCooldownAmount capital) acc
+        newAccounts <- Accounts.setAccountAtIndex ai newAcc (bspAccounts bsp)
+        maybeCooldownsAfter <- accountCooldowns newAcc
+        let accountsInCooldownForPV = bspAccountsInCooldown bsp
+        let oldAccountsInCooldown = case theAccountsInCooldownForPV accountsInCooldownForPV of
+                CTrue accounts -> accounts
+        maybeCooldowns <- releaseCooldownGlobally ai oldAccountsInCooldown maybeCooldownsBefore maybeCooldownsAfter
+        case maybeCooldowns of
+            Nothing -> return bsp{bspAccounts = newAccounts}
+            Just newCooldowns -> return bsp{bspAccounts = newAccounts, bspAccountsInCooldown = newCooldowns}
 doConfigureBaker pbs ai BakerConfigureUpdate{..} = do
     origBSP <- loadPBS pbs
     cp <- lookupCurrentParameters (bspUpdates origBSP)
@@ -1633,6 +1652,13 @@ doConfigureBaker pbs ai BakerConfigureUpdate{..} = do
         bsp <- MTL.get
         newAccounts <- liftBSO $ Accounts.updateAccountsAtIndex' updAcc ai (bspAccounts bsp)
         MTL.put bsp{bspAccounts = newAccounts}
+    setAccount acc = do
+        bsp <- MTL.get
+        newAccounts <- liftBSO $ Accounts.setAccountAtIndex ai acc (bspAccounts bsp)
+        MTL.put
+            bsp
+                { bspAccounts = newAccounts
+                }
     ifPresent Nothing _ = return return
     ifPresent (Just v) k = k v
     updateKeys oldBkr = ifPresent bcuKeys $ \keys -> do
@@ -1888,64 +1914,19 @@ doConfigureBaker pbs ai BakerConfigureUpdate{..} = do
     maybeReleaseCooldownGlobally SFalse _ _ = return ()
     maybeReleaseCooldownGlobally STrue upd acc = do
         maybeCooldownsBefore <- accountCooldowns acc
-        modifyAccount' upd
-        maybeCooldownsAfter <- accountCooldowns acc -- FIXME: We should pass in the updated account heree
-        let (shouldRemovePrePre, shouldRemovePre, shouldRemoveCooldown, shouldUpdateCooldown) =
-                case (maybeCooldownsBefore, maybeCooldownsAfter) of
-                    (Just cd, Nothing) ->
-                        ( isPresent $ CooldownQueue.prePreCooldown cd,
-                          isPresent $ CooldownQueue.preCooldown cd,
-                          Map.lookupMin (CooldownQueue.inCooldown cd),
-                          Nothing
-                        )
-                    (Just cd1, Just cd2) ->
-                        ( isPresent (CooldownQueue.prePreCooldown cd1) && isAbsent (CooldownQueue.prePreCooldown cd2),
-                          isPresent (CooldownQueue.preCooldown cd1) && isPresent (CooldownQueue.preCooldown cd2),
-                          if Map.null (CooldownQueue.inCooldown cd2) then Map.lookupMin (CooldownQueue.inCooldown cd1) else Nothing,
-                          case (Map.lookupMin (CooldownQueue.inCooldown cd1), Map.lookupMin (CooldownQueue.inCooldown cd2)) of
-                            (Just (ts1, _), Just (ts2, _)) -> if ts1 /= ts2 then Just (ts1, ts2) else Nothing
-                            _ -> Nothing
-                        )
-                    _ -> (False, False, Nothing, Nothing)
-        let shouldDo = (shouldRemovePrePre, shouldRemovePre, shouldRemoveCooldown, shouldUpdateCooldown) /= (False, False, Nothing, Nothing)
-        when shouldDo $ do
-            accountsInCooldownForPV <- MTL.gets bspAccountsInCooldown
-            let oldAccountsInCooldown = case theAccountsInCooldownForPV accountsInCooldownForPV of
-                    CTrue accounts -> accounts
-            newAccountsInCooldown1 <-
-                if shouldRemovePrePre
-                    then do
-                        newPrePreCooldown <- removeAccountFromAccountList ai $ _prePreCooldown oldAccountsInCooldown
-                        return oldAccountsInCooldown{_prePreCooldown = newPrePreCooldown}
-                    else return oldAccountsInCooldown
-            newAccountsInCooldown2 <-
-                if shouldRemovePre
-                    then do
-                        newPreCooldown <- removeAccountFromAccountList ai $ _preCooldown oldAccountsInCooldown
-                        return newAccountsInCooldown1{_preCooldown = newPreCooldown}
-                    else return newAccountsInCooldown1
-            newAccountsInCooldown3 <-
-                case shouldRemoveCooldown of
-                    Just (ts, _) -> do
-                        newCooldown <- removeAccountFromReleaseSchedule ts ai $ _cooldown oldAccountsInCooldown
-                        return newAccountsInCooldown2{_cooldown = newCooldown}
-                    Nothing -> return newAccountsInCooldown2
-            newAccountsInCooldown4 <-
-                case shouldUpdateCooldown of
-                    Just (ts1, ts2) -> do
-                        newCooldown <- updateAccountRelease ts1 ts2 ai $ _cooldown oldAccountsInCooldown
-                        return newAccountsInCooldown3{_cooldown = newCooldown}
-                    Nothing -> return newAccountsInCooldown3
-            let newAccountsInCooldownForPV =
-                    AccountsInCooldownForPV $
-                        CTrue newAccountsInCooldown4
+        newAcc <- liftBSO $ upd acc
+        setAccount newAcc
+        maybeCooldownsAfter <- accountCooldowns newAcc
+        accountsInCooldownForPV <- MTL.gets bspAccountsInCooldown
+        let oldAccountsInCooldown = case theAccountsInCooldownForPV accountsInCooldownForPV of
+                CTrue accounts -> accounts
+        maybeCooldowns <- releaseCooldownGlobally ai oldAccountsInCooldown maybeCooldownsBefore maybeCooldownsAfter
+        forM_ maybeCooldowns $ \newCooldowns ->
             MTL.modify' $ \bsp ->
                 bsp
-                    { bspAccountsInCooldown = newAccountsInCooldownForPV
+                    { bspAccountsInCooldown = newCooldowns
                     }
 
--- MTL.modify' $ \bsp -> bsp -- FIXME: FIX
-
 doConstrainBakerCommission ::
     (SupportsPersistentState pv m, PVSupportsDelegation pv) =>
     PersistentBlockState pv ->
@@ -2032,7 +2013,7 @@ doConfigureDelegation pbs ai DelegationConfigureAdd{..} = do
     bsp <- loadPBS pbs
     poolParams <- _cpPoolParameters <$> lookupCurrentParameters (bspUpdates bsp)
     result <- MTL.runExceptT $ do
-        newBSP <- updateBlockState bsp
+        newBSP <- updateBlockState (sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv))) bsp
         delegationConfigureDisallowOverdelegation newBSP poolParams dcaDelegationTarget
         return newBSP
     case result of
@@ -2040,7 +2021,11 @@ doConfigureDelegation pbs ai DelegationConfigureAdd{..} = do
         Right newBirkParams -> (DCSuccess [] did,) <$> storePBS pbs newBirkParams
   where
     did = DelegatorId ai
-    updateBlockState bsp =
+    updateBlockState ::
+        SBool (SupportsFlexibleCooldown (AccountVersionFor pv)) ->
+        BlockStatePointers pv ->
+        MTL.ExceptT DelegationConfigureResult m (BlockStatePointers pv)
+    updateBlockState SFalse bsp =
         lift (Accounts.indexedAccount ai (bspAccounts bsp)) >>= \case
             Nothing -> MTL.throwError DCInvalidAccount
             Just _ -> do
@@ -2057,6 +2042,39 @@ doConfigureDelegation pbs ai DelegationConfigureAdd{..} = do
                 -- This cannot fail to update the accounts, since we already looked up the accounts:
                 newAccounts <- lift $ Accounts.updateAccountsAtIndex' (addAccountDelegator dlg) ai (bspAccounts bsp)
                 return bsp{bspBirkParameters = newBirkParams, bspAccounts = newAccounts}
+    updateBlockState STrue bsp =
+        lift (Accounts.indexedAccount ai (bspAccounts bsp)) >>= \case
+            Nothing -> MTL.throwError DCInvalidAccount
+            Just acc -> do
+                delegationCheckTargetOpen bsp dcaDelegationTarget
+                newBirkParams <- updateBirk bsp dcaDelegationTarget
+                let dlg =
+                        BaseAccounts.AccountDelegationV1
+                            { BaseAccounts._delegationIdentity = did,
+                              BaseAccounts._delegationStakedAmount = dcaCapital,
+                              BaseAccounts._delegationStakeEarnings = dcaRestakeEarnings,
+                              BaseAccounts._delegationTarget = dcaDelegationTarget,
+                              BaseAccounts._delegationPendingChange = BaseAccounts.NoChange
+                            }
+                maybeCooldownsBefore <- accountCooldowns acc
+                newAcc <- (addAccountDelegator dlg >=> releaseCooldownAmount dcaCapital) acc
+                maybeCooldownsAfter <- accountCooldowns newAcc
+                -- This cannot fail to update the accounts, since we already looked up the accounts:
+                newAccounts <- lift $ Accounts.setAccountAtIndex ai newAcc (bspAccounts bsp)
+                let accountsInCooldownForPV = bspAccountsInCooldown bsp
+                let oldAccountsInCooldown = case theAccountsInCooldownForPV accountsInCooldownForPV of
+                        CTrue accounts -> accounts
+                maybeCooldowns <- releaseCooldownGlobally ai oldAccountsInCooldown maybeCooldownsBefore maybeCooldownsAfter
+                case maybeCooldowns of
+                    Nothing -> return bsp{bspBirkParameters = newBirkParams, bspAccounts = newAccounts}
+                    Just newCooldowns -> return bsp{bspBirkParameters = newBirkParams, bspAccounts = newAccounts, bspAccountsInCooldown = newCooldowns}
+    updateBirk ::
+        BlockStatePointers pv ->
+        DelegationTarget ->
+        MTL.ExceptT
+            DelegationConfigureResult
+            m
+            (PersistentBirkParameters pv)
     updateBirk bsp Transactions.DelegatePassive = lift $ do
         ab <- refLoad (bspBirkParameters bsp ^. birkActiveBakers)
         let PersistentActiveDelegatorsV1 dset tot = ab ^. passiveDelegators
@@ -2106,6 +2124,22 @@ doConfigureDelegation pbs ai DelegationConfigureUpdate{..} = do
             bsp
                 { bspAccounts = newAccounts
                 }
+    setAccount ::
+        PersistentAccount (AccountVersionFor pv) ->
+        MTL.StateT
+            (BlockStatePointers pv)
+            ( MTL.WriterT
+                [DelegationConfigureUpdateChange]
+                (MTL.ExceptT DelegationConfigureResult m)
+            )
+            ()
+    setAccount acc = do
+        bsp <- MTL.get
+        newAccounts <- Accounts.setAccountAtIndex ai acc (bspAccounts bsp)
+        MTL.put
+            bsp
+                { bspAccounts = newAccounts
+                }
     updateDelegationTarget = do
         (acctDlg, _) <- getAccountOrFail
         let oldTarget = acctDlg ^. BaseAccounts.delegationTarget
@@ -2187,7 +2221,7 @@ doConfigureDelegation pbs ai DelegationConfigureUpdate{..} = do
                             let oldAccountsInCooldown = case theAccountsInCooldownForPV accountsInCooldownForPV of
                                     CTrue accounts -> accounts
                                 oldPrePreCooldowns = _prePreCooldown oldAccountsInCooldown
-                            ppRef <- refMake $ AccountListItem ai oldPrePreCooldowns -- FIXME: why no lift?
+                            ppRef <- refMake $ AccountListItem ai oldPrePreCooldowns
                             let newPrePreCooldowns = Some ppRef
                                 newAccountsInCooldown =
                                     AccountsInCooldownForPV $
@@ -2250,62 +2284,21 @@ doConfigureDelegation pbs ai DelegationConfigureUpdate{..} = do
                         ab <- refLoad (bspBirkParameters bsp1 ^. birkActiveBakers)
                         newActiveBakers <- addTotalsInActiveBakers ab ad (capital - BaseAccounts._delegationStakedAmount ad)
                         maybeCooldownsBefore <- accountCooldowns acc
-                        modifyAccount $ setAccountStake capital >=> releaseCooldownAmount (capital - BaseAccounts._delegationStakedAmount ad)
-                        maybeCooldownsAfter <- accountCooldowns acc -- FIXME: We should pass in the updated account here
-                        let (shouldRemovePrePre, shouldRemovePre, shouldRemoveCooldown, shouldUpdateCooldown) = case (maybeCooldownsBefore, maybeCooldownsAfter) of
-                                (Just cd, Nothing) ->
-                                    ( isPresent $ CooldownQueue.prePreCooldown cd,
-                                      isPresent $ CooldownQueue.preCooldown cd,
-                                      Map.lookupMin (CooldownQueue.inCooldown cd),
-                                      Nothing
-                                    )
-                                (Just cd1, Just cd2) ->
-                                    ( isPresent (CooldownQueue.prePreCooldown cd1) && isAbsent (CooldownQueue.prePreCooldown cd2),
-                                      isPresent (CooldownQueue.preCooldown cd1) && isPresent (CooldownQueue.preCooldown cd2),
-                                      if Map.null (CooldownQueue.inCooldown cd2) then Map.lookupMin (CooldownQueue.inCooldown cd1) else Nothing,
-                                      case (Map.lookupMin (CooldownQueue.inCooldown cd1), Map.lookupMin (CooldownQueue.inCooldown cd2)) of
-                                        (Just (ts1, _), Just (ts2, _)) -> if ts1 /= ts2 then Just (ts1, ts2) else Nothing
-                                        _ -> Nothing
-                                    ) -- FIXME: refactor this with the stuff in configure baker
-                                _ -> (False, False, Nothing, Nothing)
-                        if (shouldRemovePrePre, shouldRemovePre, shouldRemoveCooldown, shouldUpdateCooldown) == (False, False, Nothing, Nothing)
-                            then MTL.modify' $ \bsp -> bsp{bspBirkParameters = bspBirkParameters bsp1 & birkActiveBakers .~ newActiveBakers}
-                            else do
-                                accountsInCooldownForPV <- MTL.gets bspAccountsInCooldown
-                                let oldAccountsInCooldown = case theAccountsInCooldownForPV accountsInCooldownForPV of
-                                        CTrue accounts -> accounts
-                                newAccountsInCooldown1 <-
-                                    if shouldRemovePrePre
-                                        then do
-                                            newPrePreCooldown <- removeAccountFromAccountList ai $ _prePreCooldown oldAccountsInCooldown
-                                            return oldAccountsInCooldown{_prePreCooldown = newPrePreCooldown}
-                                        else return oldAccountsInCooldown
-                                newAccountsInCooldown2 <-
-                                    if shouldRemovePre
-                                        then do
-                                            newPreCooldown <- removeAccountFromAccountList ai $ _preCooldown oldAccountsInCooldown
-                                            return newAccountsInCooldown1{_preCooldown = newPreCooldown}
-                                        else return newAccountsInCooldown1
-                                newAccountsInCooldown3 <-
-                                    case shouldRemoveCooldown of
-                                        Just (ts, _) -> do
-                                            newCooldown <- removeAccountFromReleaseSchedule ts ai $ _cooldown oldAccountsInCooldown
-                                            return newAccountsInCooldown2{_cooldown = newCooldown}
-                                        Nothing -> return newAccountsInCooldown2
-                                newAccountsInCooldown4 <-
-                                    case shouldUpdateCooldown of
-                                        Just (ts1, ts2) -> do
-                                            newCooldown <- updateAccountRelease ts1 ts2 ai $ _cooldown oldAccountsInCooldown
-                                            return newAccountsInCooldown3{_cooldown = newCooldown}
-                                        Nothing -> return newAccountsInCooldown3
-                                let newAccountsInCooldownForPV =
-                                        AccountsInCooldownForPV $
-                                            CTrue newAccountsInCooldown4
-                                MTL.modify' $ \bsp ->
-                                    bsp
-                                        { bspBirkParameters = bspBirkParameters bsp1 & birkActiveBakers .~ newActiveBakers,
-                                          bspAccountsInCooldown = newAccountsInCooldownForPV
-                                        }
+                        let accUpd = setAccountStake capital >=> releaseCooldownAmount (capital - BaseAccounts._delegationStakedAmount ad)
+                        newAcc <- accUpd acc
+                        setAccount newAcc
+                        maybeCooldownsAfter <- accountCooldowns newAcc
+                        accountsInCooldownForPV <- MTL.gets bspAccountsInCooldown
+                        let oldAccountsInCooldown = case theAccountsInCooldownForPV accountsInCooldownForPV of
+                                CTrue accounts -> accounts
+                        maybeCooldowns <- releaseCooldownGlobally ai oldAccountsInCooldown maybeCooldownsBefore maybeCooldownsAfter
+                        case maybeCooldowns of
+                            Nothing -> MTL.modify' $ \bsp -> bsp{bspBirkParameters = bspBirkParameters bsp1 & birkActiveBakers .~ newActiveBakers}
+                            Just newCooldowns -> MTL.modify' $ \bsp ->
+                                bsp
+                                    { bspBirkParameters = bspBirkParameters bsp1 & birkActiveBakers .~ newActiveBakers,
+                                      bspAccountsInCooldown = newCooldowns
+                                    }
                         MTL.tell [DelegationConfigureStakeIncreased capital]
         return $ BaseAccounts._delegationStakedAmount ad
     addTotalsInActiveBakers ab0 ad delta = do
@@ -2359,6 +2352,60 @@ doConfigureDelegation pbs ai DelegationConfigureUpdate{..} = do
             (Nothing, Just newTarget) -> unless (newTarget == oldTarget) doCheckOverDelegation
             _ -> return ()
 
+releaseCooldownGlobally ::
+    (MonadBlobStore m, SupportsFlexibleCooldown (AccountVersionFor pv) ~ 'True) =>
+    AccountIndex ->
+    AccountsInCooldown ->
+    Maybe CooldownQueue.Cooldowns ->
+    Maybe CooldownQueue.Cooldowns ->
+    m (Maybe (AccountsInCooldownForPV pv))
+releaseCooldownGlobally ai oldAccountsInCooldown maybeCooldownsBefore maybeCooldownsAfter = do
+    let (shouldRemovePrePre, shouldRemovePre, shouldRemoveCooldown, shouldUpdateCooldown) =
+            case (maybeCooldownsBefore, maybeCooldownsAfter) of
+                (Just cd, Nothing) ->
+                    ( isPresent $ CooldownQueue.prePreCooldown cd,
+                      isPresent $ CooldownQueue.preCooldown cd,
+                      Map.lookupMin (CooldownQueue.inCooldown cd),
+                      Nothing
+                    )
+                (Just cd1, Just cd2) ->
+                    ( isPresent (CooldownQueue.prePreCooldown cd1) && isAbsent (CooldownQueue.prePreCooldown cd2),
+                      isPresent (CooldownQueue.preCooldown cd1) && isAbsent (CooldownQueue.preCooldown cd2),
+                      if Map.null (CooldownQueue.inCooldown cd2) then Map.lookupMin (CooldownQueue.inCooldown cd1) else Nothing,
+                      case (Map.lookupMin (CooldownQueue.inCooldown cd1), Map.lookupMin (CooldownQueue.inCooldown cd2)) of
+                        (Just (ts1, _), Just (ts2, _)) -> if ts1 /= ts2 then Just (ts1, ts2) else Nothing
+                        _ -> Nothing
+                    ) -- FIXME: refactor this with the stuff in configure baker
+                _ -> (False, False, Nothing, Nothing)
+    if (shouldRemovePrePre, shouldRemovePre, shouldRemoveCooldown, shouldUpdateCooldown) == (False, False, Nothing, Nothing)
+        then return Nothing
+        else do
+            newAccountsInCooldown1 <-
+                if shouldRemovePrePre
+                    then do
+                        newPrePreCooldown <- removeAccountFromAccountList ai $ _prePreCooldown oldAccountsInCooldown
+                        return oldAccountsInCooldown{_prePreCooldown = newPrePreCooldown}
+                    else return oldAccountsInCooldown
+            newAccountsInCooldown2 <-
+                if shouldRemovePre
+                    then do
+                        newPreCooldown <- removeAccountFromAccountList ai $ _preCooldown oldAccountsInCooldown
+                        return newAccountsInCooldown1{_preCooldown = newPreCooldown}
+                    else return newAccountsInCooldown1
+            newAccountsInCooldown3 <-
+                case shouldRemoveCooldown of
+                    Just (ts, _) -> do
+                        newCooldown <- removeAccountFromReleaseSchedule ts ai $ _cooldown oldAccountsInCooldown
+                        return newAccountsInCooldown2{_cooldown = newCooldown}
+                    Nothing -> return newAccountsInCooldown2
+            newAccountsInCooldown4 <-
+                case shouldUpdateCooldown of
+                    Just (ts1, ts2) -> do
+                        newCooldown <- updateAccountRelease ts1 ts2 ai $ _cooldown oldAccountsInCooldown
+                        return newAccountsInCooldown3{_cooldown = newCooldown}
+                    Nothing -> return newAccountsInCooldown3
+            return $ Just $ AccountsInCooldownForPV $ CTrue newAccountsInCooldown4
+
 doUpdateBakerKeys ::
     (SupportsPersistentState pv m, AccountVersionFor pv ~ 'AccountV0) =>
     PersistentBlockState pv ->

From 2ae417ef04e7529f8675c25c8664d38e66bf7328 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Wed, 17 Jul 2024 11:17:31 +0200
Subject: [PATCH 28/81] Add testing for epoch transitions.

---
 .../src/Concordium/GlobalState/Account.hs     | 22 +++++++++++++++++++
 .../GlobalState/Persistent/BlockState.hs      |  3 +++
 .../src/Concordium/KonsensusV1/Scheduler.hs   |  1 +
 concordium-consensus/tests/scheduler/Spec.hs  |  2 ++
 4 files changed, 28 insertions(+)

diff --git a/concordium-consensus/src/Concordium/GlobalState/Account.hs b/concordium-consensus/src/Concordium/GlobalState/Account.hs
index 3544fbbb0..e8287e3c9 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Account.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Account.hs
@@ -7,6 +7,7 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
 
 module Concordium.GlobalState.Account where
 
@@ -555,3 +556,24 @@ data StakeDetails (av :: AccountVersion) where
           sdDelegationTarget :: !DelegationTarget
         } ->
         StakeDetails av
+
+instance (Show (PendingChangeEffective av)) => Show (StakeDetails av) where
+    show StakeDetailsNone = "StakeDetailsNone"
+    show StakeDetailsBaker{..} =
+        "StakeDetailsBaker {sdStakedCapital = "
+            <> show sdStakedCapital
+            <> ", sdRestakeEarnings = "
+            <> show sdRestakeEarnings
+            <> ", sdPendingChange = "
+            <> show sdPendingChange
+            <> "}"
+    show StakeDetailsDelegator{..} =
+        "StakeDetailsDelegator {sdStakedCapital = "
+            <> show sdStakedCapital
+            <> ", sdRestakeEarnings = "
+            <> show sdRestakeEarnings
+            <> ", sdPendingChange = "
+            <> show sdPendingChange
+            <> ", sdDelegationTarget = "
+            <> show sdDelegationTarget
+            <> "}"
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
index cd079eaac..7a5491631 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
@@ -23,6 +23,7 @@ module Concordium.GlobalState.Persistent.BlockState (
     HashedPersistentBlockState (..),
     hashBlockState,
     PersistentBirkParameters (..),
+    initialBirkParameters,
     initialPersistentState,
     emptyBlockState,
     emptyHashedEpochBlocks,
@@ -38,6 +39,7 @@ module Concordium.GlobalState.Persistent.BlockState (
     migratePersistentBlockState,
     SupportsPersistentState,
     loadPBS,
+    storePBS,
 ) where
 
 import qualified Concordium.Crypto.SHA256 as H
@@ -1040,6 +1042,7 @@ loadPBS :: (SupportsPersistentState pv m) => PersistentBlockState pv -> m (Block
 loadPBS = loadBufferedRef <=< liftIO . readIORef
 {-# INLINE loadPBS #-}
 
+-- | Update the 'BlockStatePointers' stored in a 'PersistentBlockState'.
 storePBS :: (SupportsPersistentAccount pv m) => PersistentBlockState pv -> BlockStatePointers pv -> m (PersistentBlockState pv)
 storePBS pbs bsp = liftIO $ do
     pbsp <- makeBufferedRef bsp
diff --git a/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs b/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs
index a0a445f79..cabe27442 100644
--- a/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs
+++ b/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs
@@ -50,6 +50,7 @@ data PaydayParameters = PaydayParameters
       -- | The mint rate for the payday.
       paydayMintRate :: MintRate
     }
+    deriving (Show, Eq)
 
 -- | The bakers that participated in the block. Used for determining rewards.
 --
diff --git a/concordium-consensus/tests/scheduler/Spec.hs b/concordium-consensus/tests/scheduler/Spec.hs
index 54c8d97c0..210660b7e 100644
--- a/concordium-consensus/tests/scheduler/Spec.hs
+++ b/concordium-consensus/tests/scheduler/Spec.hs
@@ -52,6 +52,7 @@ import qualified SchedulerTests.SmartContracts.V1.Upgrading (tests)
 import qualified SchedulerTests.SmartContracts.V1.UpgradingPersistent (tests)
 import qualified SchedulerTests.SmartContracts.V1.ValidInvalidModules (tests)
 
+import qualified SchedulerTests.KonsensusV1.EpochTransition (tests)
 import Test.Hspec
 
 main :: IO ()
@@ -105,3 +106,4 @@ main = hspec $ do
     SchedulerTests.SmartContracts.V1.CustomSectionSize.tests
     SchedulerTests.SmartContracts.V1.AccountSignatureChecks.tests
     SchedulerTests.SmartContracts.V1.InspectModuleReferenceAndContractName.tests
+    SchedulerTests.KonsensusV1.EpochTransition.tests

From 0cad46af655939b409a6bd6e2fde6054730bb763 Mon Sep 17 00:00:00 2001
From: Emil B <eb@concordium.com>
Date: Thu, 18 Jul 2024 19:32:12 +0200
Subject: [PATCH 29/81] Allow immediate switch from delegator to baker.

---
 .../GlobalState/Persistent/BlockState.hs      | 116 +++++++++++++++---
 .../src/Concordium/Scheduler.hs               |  37 +++++-
 2 files changed, 134 insertions(+), 19 deletions(-)

diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
index b730170e6..8fd1c613d 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
@@ -1548,7 +1548,9 @@ doConfigureBaker pbs ai BakerConfigureAdd{..} = do
                         return (BCFinalizationRewardCommissionNotInRange, pbs)
                     | otherwise -> do
                         let bid = BakerId ai
-                        pab <- refLoad (_birkActiveBakers (bspBirkParameters bsp))
+                        oldPAB <- refLoad (_birkActiveBakers (bspBirkParameters bsp))
+                        maybeDel <- accountDelegator acc
+                        pab <- maybeRemoveDelegator (sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv))) maybeDel oldPAB
                         let updAgg Nothing = return (True, Trie.Insert ())
                             updAgg (Just ()) = return (False, Trie.NoChange)
                         Trie.adjust updAgg (bkuAggregationKey bcaKeys) (_aggregationKeys pab) >>= \case
@@ -1584,35 +1586,117 @@ doConfigureBaker pbs ai BakerConfigureAdd{..} = do
                                               _bieBakerInfo = bakerInfo
                                             }
                                     updAcc = addAccountBakerV1 bakerInfoEx bcaCapital bcaRestakeEarnings
-                                -- This cannot fail to update the account, since we already looked up the account.
-                                newBSP <- updateAccountsAndMaybeCooldown (sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv))) acc updAcc bcaCapital bsp{bspBirkParameters = newBirkParams}
+                                newBSP <-
+                                    updateAccountsAndMaybeCooldown
+                                        (sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv)))
+                                        acc
+                                        maybeDel
+                                        updAcc
+                                        bcaCapital
+                                        bsp{bspBirkParameters = newBirkParams}
                                 (BCSuccess [] bid,)
                                     <$> storePBS
                                         pbs
                                         newBSP
   where
+    maybeRemoveDelegator ::
+        SBool (SupportsFlexibleCooldown (AccountVersionFor pv)) ->
+        Maybe (BaseAccounts.AccountDelegation (AccountVersionFor pv)) ->
+        PersistentActiveBakers (AccountVersionFor pv) ->
+        m (PersistentActiveBakers (AccountVersionFor pv))
+    maybeRemoveDelegator SFalse _ pab = return pab
+    maybeRemoveDelegator STrue Nothing pab = return pab
+    maybeRemoveDelegator STrue (Just del) pab = do
+        let delStake = BaseAccounts._delegationStakedAmount del
+            pab1 = pab & totalActiveCapital %~ subtractActiveCapital delStake
+        case del ^. BaseAccounts.delegationTarget of
+            Transactions.DelegatePassive -> do
+                let PersistentActiveDelegatorsV1 dset dtot = pab1 ^. passiveDelegators
+                newDelegatorSet <- Trie.delete (del ^. BaseAccounts.delegationIdentity) dset
+                return $ pab1 & passiveDelegators .~ PersistentActiveDelegatorsV1 newDelegatorSet (dtot - delStake)
+            Transactions.DelegateToBaker bid -> do
+                Trie.lookup bid (pab ^. activeBakers) >>= \case
+                    Nothing -> error "Invariant violation: delegation target is not an active baker"
+                    Just (PersistentActiveDelegatorsV1 dset dtot) -> do
+                        newDelegatorSet <- Trie.delete (del ^. BaseAccounts.delegationIdentity) dset
+                        newActiveMap <- Trie.insert bid (PersistentActiveDelegatorsV1 newDelegatorSet (dtot - delStake)) (pab1 ^. activeBakers)
+                        return $ pab1 & activeBakers .~ newActiveMap
     updateAccountsAndMaybeCooldown ::
         SBool (SupportsFlexibleCooldown (AccountVersionFor pv)) ->
         PersistentAccount (AccountVersionFor pv) ->
+        Maybe (BaseAccounts.AccountDelegation (AccountVersionFor pv)) ->
         (PersistentAccount (AccountVersionFor pv) -> m (PersistentAccount (AccountVersionFor pv))) ->
         Amount ->
         BlockStatePointers pv ->
         m (BlockStatePointers pv)
-    updateAccountsAndMaybeCooldown SFalse _ updAcc _ bsp = do
+    updateAccountsAndMaybeCooldown SFalse _ _ updAcc _ bsp = do
+        -- This cannot fail to update the account, since we already looked up the account.
         newAccounts <- Accounts.updateAccountsAtIndex' updAcc ai (bspAccounts bsp)
         return bsp{bspAccounts = newAccounts}
-    updateAccountsAndMaybeCooldown STrue acc updAcc capital bsp = do
-        maybeCooldownsBefore <- accountCooldowns acc
-        newAcc <- (updAcc >=> releaseCooldownAmount capital) acc
-        newAccounts <- Accounts.setAccountAtIndex ai newAcc (bspAccounts bsp)
-        maybeCooldownsAfter <- accountCooldowns newAcc
-        let accountsInCooldownForPV = bspAccountsInCooldown bsp
-        let oldAccountsInCooldown = case theAccountsInCooldownForPV accountsInCooldownForPV of
-                CTrue accounts -> accounts
-        maybeCooldowns <- releaseCooldownGlobally ai oldAccountsInCooldown maybeCooldownsBefore maybeCooldownsAfter
-        case maybeCooldowns of
-            Nothing -> return bsp{bspAccounts = newAccounts}
-            Just newCooldowns -> return bsp{bspAccounts = newAccounts, bspAccountsInCooldown = newCooldowns}
+    updateAccountsAndMaybeCooldown STrue acc maybeDel updAcc capital bsp = do
+        case maybeDel of
+            Nothing -> do
+                maybeCooldownsBefore <- accountCooldowns acc
+                newAcc <- (updAcc >=> releaseCooldownAmount capital) acc
+                -- This cannot fail to update the account, since we already looked up the account.
+                newAccounts <- Accounts.setAccountAtIndex ai newAcc (bspAccounts bsp)
+                maybeCooldownsAfter <- accountCooldowns newAcc
+                let accountsInCooldownForPV = bspAccountsInCooldown bsp
+                let oldAccountsInCooldown = case theAccountsInCooldownForPV accountsInCooldownForPV of
+                        CTrue accounts -> accounts
+                maybeCooldowns <- releaseCooldownGlobally ai oldAccountsInCooldown maybeCooldownsBefore maybeCooldownsAfter
+                case maybeCooldowns of
+                    Nothing -> return bsp{bspAccounts = newAccounts}
+                    Just newCooldowns -> return bsp{bspAccounts = newAccounts, bspAccountsInCooldown = newCooldowns}
+            Just del -> do
+                case compare capital (BaseAccounts._delegationStakedAmount del) of
+                    LT -> do
+                        -- This cannot fail to update the account, since we already looked up the account.
+                        newAccounts <-
+                            Accounts.updateAccountsAtIndex'
+                                (updAcc >=> addAccountPrePreCooldown (BaseAccounts._delegationStakedAmount del - capital))
+                                ai
+                                (bspAccounts bsp)
+                        let notAlreadyInPrePreCooldown = do
+                                let accountsInCooldownForPV = bspAccountsInCooldown bsp
+                                let oldAccountsInCooldown = case theAccountsInCooldownForPV accountsInCooldownForPV of
+                                        CTrue accounts -> accounts
+                                    oldPrePreCooldowns = _prePreCooldown oldAccountsInCooldown
+                                ppRef <- refMake $ AccountListItem ai oldPrePreCooldowns
+                                let newPrePreCooldowns = Some ppRef
+                                    newAccountsInCooldown =
+                                        AccountsInCooldownForPV $
+                                            CTrue
+                                                oldAccountsInCooldown{_prePreCooldown = newPrePreCooldowns}
+                                return
+                                    bsp
+                                        { bspAccounts = newAccounts,
+                                          bspAccountsInCooldown = newAccountsInCooldown
+                                        }
+                        maybeCooldowns <- accountCooldowns acc
+                        case maybeCooldowns of
+                            Nothing -> notAlreadyInPrePreCooldown
+                            Just cooldowns -> case CooldownQueue.prePreCooldown cooldowns of
+                                Absent -> notAlreadyInPrePreCooldown
+                                Present _ ->
+                                    return bsp{bspAccounts = newAccounts}
+                    EQ -> do
+                        -- This cannot fail to update the account, since we already looked up the account.
+                        newAccounts <- Accounts.updateAccountsAtIndex' updAcc ai (bspAccounts bsp)
+                        return bsp{bspAccounts = newAccounts}
+                    GT -> do
+                        maybeCooldownsBefore <- accountCooldowns acc
+                        -- This cannot fail to update the account, since we already looked up the account.
+                        newAcc <- (updAcc >=> releaseCooldownAmount (capital - BaseAccounts._delegationStakedAmount del)) acc
+                        newAccounts <- Accounts.setAccountAtIndex ai newAcc (bspAccounts bsp)
+                        maybeCooldownsAfter <- accountCooldowns newAcc
+                        let accountsInCooldownForPV = bspAccountsInCooldown bsp
+                        let oldAccountsInCooldown = case theAccountsInCooldownForPV accountsInCooldownForPV of
+                                CTrue accounts -> accounts
+                        maybeCooldowns <- releaseCooldownGlobally ai oldAccountsInCooldown maybeCooldownsBefore maybeCooldownsAfter
+                        case maybeCooldowns of
+                            Nothing -> return bsp{bspAccounts = newAccounts}
+                            Just newCooldowns -> return bsp{bspAccounts = newAccounts, bspAccountsInCooldown = newCooldowns}
 doConfigureBaker pbs ai BakerConfigureUpdate{..} = do
     origBSP <- loadPBS pbs
     cp <- lookupCurrentParameters (bspUpdates origBSP)
diff --git a/concordium-consensus/src/Concordium/Scheduler.hs b/concordium-consensus/src/Concordium/Scheduler.hs
index 54de26c90..58ab44422 100644
--- a/concordium-consensus/src/Concordium/Scheduler.hs
+++ b/concordium-consensus/src/Concordium/Scheduler.hs
@@ -2022,6 +2022,17 @@ data ConfigureBakerCont
         }
     | ConfigureUpdateBakerCont
 
+-- \| SwitchToBakerCont
+--     { stbcCapital :: !(Maybe Amount),
+--       stbcRestakeEarnings :: !(Maybe Bool),
+--       stbcOpenForDelegation :: !OpenStatus,
+--       stbcKeysWithProofs :: !BakerKeysWithProofs,
+--       stbcMetadataURL :: !UrlText,
+--       stbcTransactionFeeCommission :: !AmountFraction,
+--       stbcBakingRewardCommission :: !AmountFraction,
+--       stbcFinalizationRewardCommission :: !AmountFraction
+--     }
+
 -- | Argument to configure delegation 'withDeposit' continuation.
 data ConfigureDelegationCont
     = ConfigureAddDelegationCont
@@ -2090,6 +2101,27 @@ handleConfigureBaker
                         return ConfigureAddBakerCont{..}
                 _ ->
                     rejectTransaction MissingBakerAddParameters
+        switchToBakerArg :: Amount -> Bool -> LocalT (ConfigureBakerCont, Amount) m ConfigureBakerCont
+        switchToBakerArg amt restake =
+            let cbcCapital = fromMaybe amt cbCapital
+                cbcRestakeEarnings = fromMaybe restake cbRestakeEarnings
+            in  case ( cbOpenForDelegation,
+                       cbKeysWithProofs,
+                       cbMetadataURL,
+                       cbTransactionFeeCommission,
+                       cbBakingRewardCommission,
+                       cbFinalizationRewardCommission
+                     ) of
+                    ( Just cbcOpenForDelegation,
+                      Just cbcKeysWithProofs,
+                      Just cbcMetadataURL,
+                      Just cbcTransactionFeeCommission,
+                      Just cbcBakingRewardCommission,
+                      Just cbcFinalizationRewardCommission
+                        ) ->
+                            return ConfigureAddBakerCont{..}
+                    _ ->
+                        rejectTransaction MissingBakerAddParameters
         configureUpdateBakerArg =
             return ConfigureUpdateBakerCont
         areKeysOK BakerKeysWithProofs{..} =
@@ -2106,10 +2138,9 @@ handleConfigureBaker
             accountStake <- getAccountStake (snd senderAccount)
             arg <- case accountStake of
                 AccountStakeNone -> configureAddBakerArg
-                -- FIXME: in new consensus, allow direct switch between baker and delegator.
-                AccountStakeDelegate _ -> case sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor (MPV m))) of
+                AccountStakeDelegate del -> case sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor (MPV m))) of
                     SFalse -> rejectTransaction AlreadyADelegator
-                    STrue -> undefined
+                    STrue -> switchToBakerArg (_delegationStakedAmount del) (_delegationStakeEarnings del)
                 AccountStakeBaker _ ->
                     configureUpdateBakerArg
             (arg,) <$> getCurrentAccountTotalAmount senderAccount

From e920c095201a8bde31eb2e7556ce0ccd334f8286 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Fri, 19 Jul 2024 17:45:33 +0200
Subject: [PATCH 30/81] Refactoring and simplifying reactivation of cooldown
 stake.

---
 .../Concordium/GlobalState/CooldownQueue.hs   |  35 ++-
 .../GlobalState/Persistent/Account.hs         |  18 +-
 .../Persistent/Account/CooldownQueue.hs       |  27 ++
 .../Persistent/Account/StructureV1.hs         |  91 ++----
 .../GlobalState/Persistent/BlockState.hs      | 291 ++++++++----------
 .../GlobalState/Persistent/Cooldown.hs        |   5 +-
 .../GlobalStateTests/CooldownQueue.hs         |  71 +++++
 7 files changed, 307 insertions(+), 231 deletions(-)

diff --git a/concordium-consensus/src/Concordium/GlobalState/CooldownQueue.hs b/concordium-consensus/src/Concordium/GlobalState/CooldownQueue.hs
index f9d935a03..f2d9b2fd8 100644
--- a/concordium-consensus/src/Concordium/GlobalState/CooldownQueue.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/CooldownQueue.hs
@@ -24,8 +24,8 @@ import Data.Foldable
 -- | The amounts that are currently in cooldown and any pre-cooldown and pre-pre-cooldown target
 -- balances.
 data Cooldowns = Cooldowns
-    { -- | Amounts currently in cooldown.
-      -- (Must have fewer than 2^62 entries.)
+    { -- | Amounts currently in cooldown, indexed by their expiry timestamp.
+      --  (Must have fewer than 2^62 entries.)
       inCooldown :: !(Map.Map Timestamp Amount),
       -- | The amount in pre-cooldown.
       --  This will enter cooldown at the next payday.
@@ -95,6 +95,37 @@ cooldownTotal Cooldowns{..} =
 instance HashableTo Hash.Hash Cooldowns where
     getHash = getHash . encode
 
+-- | Add the given amount to the pre-pre-cooldown.
+addPrePreCooldown :: Amount -> Cooldowns -> Cooldowns
+addPrePreCooldown amt Cooldowns{..} =
+    Cooldowns
+        { prePreCooldown = Present (ofOption amt (+ amt) prePreCooldown),
+          ..
+        }
+
+-- | Remove up to the given amount from the cooldowns, starting with pre-pre-cooldown, then
+--  pre-cooldown, and finally from the amounts in cooldown, in decreasing order of timestamp.
+reactivateCooldownAmount :: Amount -> Cooldowns -> Cooldowns
+reactivateCooldownAmount = reactivatePrePre
+  where
+    reactivateHelper more update available amt cd = case available of
+        Absent -> more amt cd
+        Present availableAmt -> case availableAmt `compare` amt of
+            LT -> more (amt - availableAmt) $ update Absent
+            EQ -> update Absent
+            GT -> update (Present (availableAmt - amt))
+    reactivatePrePre amt cd =
+        reactivateHelper reactivatePre (\pp -> cd{prePreCooldown = pp}) (prePreCooldown cd) amt cd
+    reactivatePre amt cd =
+        reactivateHelper reactivateInCooldown (\p -> cd{preCooldown = p}) (preCooldown cd) amt cd
+    reactivateInCooldown amt cd = reactivateCooldown (Map.toDescList $ inCooldown cd) amt cd
+    reactivateCooldown [] _ cd = cd
+    reactivateCooldown ((ts, availableAmount) : rest) amt cd =
+        case availableAmount `compare` amt of
+            LT -> reactivateCooldown rest (amt - availableAmount) cd{inCooldown = Map.delete ts (inCooldown cd)}
+            EQ -> cd{inCooldown = Map.delete ts (inCooldown cd)}
+            GT -> cd{inCooldown = Map.insert ts (availableAmount - amt) (inCooldown cd)}
+
 -- | Remove any amounts in cooldown with timestamp before or equal to the given timestamp.
 processCooldowns :: Timestamp -> Cooldowns -> Cooldowns
 processCooldowns ts Cooldowns{..} =
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs
index cd08f2b24..2a295c3d9 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs
@@ -399,10 +399,11 @@ addAccountBakerV1 binfo amt restake (PAV1 acc) = PAV1 <$> V0.addBakerV1 binfo am
 addAccountBakerV1 binfo amt restake (PAV2 acc) = PAV2 <$> V1.addBakerV1 binfo amt restake acc
 addAccountBakerV1 binfo amt restake (PAV3 acc) = PAV3 <$> V1.addBakerV1 binfo amt restake acc
 
--- | Add a baker to an account for account version 1.
---  This will replace any existing staking information on the account.
+-- | Remove a baker/delegator from an account.
+--  This removes any baker or delegator record and sets the active stake to 0.
+--  This does not affect the stake in cooldown, which should be updated separately.
 removeAccountStake ::
-    (MonadBlobStore m, SupportsFlexibleCooldown av ~ 'True) =>
+    (MonadBlobStore m, AVSupportsFlexibleCooldown av) =>
     PersistentAccount av ->
     m (PersistentAccount av)
 removeAccountStake (PAV3 acc) = PAV3 <$> V1.removeStake acc
@@ -454,19 +455,22 @@ setAccountStake newStake (PAV1 acc) = PAV1 <$> V0.setStake newStake acc
 setAccountStake newStake (PAV2 acc) = PAV2 <$> V1.setStake newStake acc
 setAccountStake newStake (PAV3 acc) = PAV3 <$> V1.setStake newStake acc
 
+-- | Add a specified amount to the pre-pre-cooldown inactive stake.
 addAccountPrePreCooldown ::
-    (MonadBlobStore m, SupportsFlexibleCooldown av ~ 'True) =>
+    (MonadBlobStore m, AVSupportsFlexibleCooldown av) =>
     Amount ->
     PersistentAccount av ->
     m (PersistentAccount av)
 addAccountPrePreCooldown amt (PAV3 acc) = PAV3 <$> V1.addPrePreCooldown amt acc
 
-releaseCooldownAmount ::
-    (MonadBlobStore m, SupportsFlexibleCooldown av ~ 'True) =>
+-- | Remove up to the given amount from the cooldowns, starting with pre-pre-cooldown, then
+--  pre-cooldown, and finally from the amounts in cooldown, in decreasing order of timestamp.
+reactivateCooldownAmount ::
+    (MonadBlobStore m, AVSupportsFlexibleCooldown av) =>
     Amount ->
     PersistentAccount av ->
     m (PersistentAccount av)
-releaseCooldownAmount amt (PAV3 acc) = PAV3 <$> V1.releaseCooldownAmount amt acc
+reactivateCooldownAmount amt (PAV3 acc) = PAV3 <$> V1.reactivateCooldownAmount amt acc
 
 -- | Set whether a baker or delegator account restakes its earnings.
 --  This MUST only be called with an account that is either a baker or delegator.
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/CooldownQueue.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/CooldownQueue.hs
index 9060f9d7d..00323d322 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/CooldownQueue.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/CooldownQueue.hs
@@ -124,6 +124,33 @@ cooldownStake :: CooldownQueue av -> Amount
 cooldownStake EmptyCooldownQueue = 0
 cooldownStake (CooldownQueue queueRef) = cooldownTotal $ eagerBufferedDeref queueRef
 
+-- | Add the given amount to the pre-pre-cooldown.
+addPrePreCooldown ::
+    (MonadBlobStore m, AVSupportsFlexibleCooldown av) =>
+    -- | The amount to add to the pre-pre-cooldown.
+    Amount ->
+    CooldownQueue av ->
+    m (CooldownQueue av)
+addPrePreCooldown amount EmptyCooldownQueue = initialPrePreCooldownQueue amount
+addPrePreCooldown amount (CooldownQueue queueRef) = do
+    let oldCooldowns = eagerBufferedDeref queueRef
+    let !newCooldowns = Cooldowns.addPrePreCooldown amount oldCooldowns
+    makeCooldownQueue newCooldowns
+
+-- | Remove up to the given amount from the cooldowns, starting with pre-pre-cooldown, then
+--  pre-cooldown, and finally from the amounts in cooldown, in decreasing order of timestamp.
+reactivateCooldownAmount ::
+    (MonadBlobStore m, AVSupportsFlexibleCooldown av) =>
+    -- | The amount to reactivate.
+    Amount ->
+    CooldownQueue av ->
+    m (CooldownQueue av)
+reactivateCooldownAmount _ EmptyCooldownQueue = return EmptyCooldownQueue
+reactivateCooldownAmount amount (CooldownQueue queueRef) = do
+    let oldCooldowns = eagerBufferedDeref queueRef
+    let !newCooldowns = Cooldowns.reactivateCooldownAmount amount oldCooldowns
+    makeCooldownQueue newCooldowns
+
 -- | Process all cooldowns that expire at or before the given timestamp.
 --   This returns the next timestamp at which a cooldown expires, if any.
 processCooldownsUntil ::
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
index 86e06265e..80b6ea9bc 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
@@ -19,6 +19,7 @@ import Control.Monad
 import Control.Monad.Trans
 import qualified Control.Monad.Trans.State.Strict as State
 import Data.Bits
+import Data.Bool.Singletons
 import Data.Foldable
 import qualified Data.Map.Strict as Map
 import Data.Serialize
@@ -26,6 +27,7 @@ import Data.Word
 import Lens.Micro.Platform
 
 import qualified Concordium.Crypto.SHA256 as Hash
+import Concordium.Genesis.Data
 import Concordium.ID.Types hiding (values)
 import Concordium.Types
 import Concordium.Types.Accounts
@@ -36,7 +38,6 @@ import Concordium.Types.Option
 import Concordium.Types.Parameters
 import Concordium.Utils
 
-import Concordium.Genesis.Data
 import Concordium.GlobalState.Account hiding (addIncomingEncryptedAmount, addToSelfEncryptedAmount, replaceUpTo)
 import Concordium.GlobalState.BakerInfo
 import qualified Concordium.GlobalState.Basic.BlockState.Account as Transient
@@ -52,7 +53,6 @@ import Concordium.GlobalState.Persistent.BlobStore
 import qualified Concordium.GlobalState.Persistent.BlockState.AccountReleaseSchedule as ARSV0
 import Concordium.GlobalState.Persistent.BlockState.AccountReleaseScheduleV1
 import Concordium.ID.Parameters
-import Data.Bool.Singletons
 
 -- * Terminology
 
@@ -776,7 +776,7 @@ data PersistentAccount av = PersistentAccount
       accountNonce :: !Nonce,
       -- | The total balance of the account.
       accountAmount :: !Amount,
-      -- | The staked balance of the account.
+      -- | The actively staked balance of the account.
       --  INVARIANT: This is 0 if the account is not a baker or delegator.
       accountStakedAmount :: !Amount,
       -- | The enduring account data.
@@ -1252,17 +1252,22 @@ addBakerV1 binfo stake restake acc = do
               accountEnduringData = newEnduring
             }
 
--- | Remove a baker/delegator from an account for account version 1.
---  This will replace any existing staking information on the account.
+-- | Remove a baker/delegator from an account.
+--  This removes any baker or delegator record and sets the active stake to 0.
+--  This does not affect the stake in cooldown, which should be updated separately.
 removeStake ::
-    (MonadBlobStore m, IsAccountVersion av, AccountStructureVersionFor av ~ 'AccountStructureV1) =>
-    -- | Account to add baker to
+    ( MonadBlobStore m,
+      IsAccountVersion av,
+      AccountStructureVersionFor av ~ 'AccountStructureV1,
+      AVSupportsFlexibleCooldown av
+    ) =>
+    -- | Account remove staking from.
     PersistentAccount av ->
     m (PersistentAccount av)
 removeStake acc = do
     let ed = enduringData acc
-    let baker = PersistentAccountStakeEnduringNone
-    newEnduring <- refMake =<< rehashAccountEnduringData ed{paedStake = baker}
+    let newStake = PersistentAccountStakeEnduringNone
+    newEnduring <- refMake =<< rehashAccountEnduringData ed{paedStake = newStake}
     return $!
         acc
             { accountStakedAmount = 0,
@@ -1352,77 +1357,39 @@ setStake ::
     m (PersistentAccount av)
 setStake newStake acc = return $! acc{accountStakedAmount = newStake}
 
+-- | Add a specified amount to the pre-pre-cooldown inactive stake.
 addPrePreCooldown ::
     forall m av.
     ( MonadBlobStore m,
       IsAccountVersion av,
       AccountStructureVersionFor av ~ 'AccountStructureV1,
-      SupportsFlexibleCooldown av ~ 'True
+      AVSupportsFlexibleCooldown av
     ) =>
     Amount ->
     PersistentAccount av ->
     m (PersistentAccount av)
 addPrePreCooldown amt = updateEnduringData $ \ed -> do
-    let oldCooldown = paedStakeCooldown ed
-    let newCooldowns = case oldCooldown of
-            EmptyCooldownQueue -> emptyCooldowns{prePreCooldown = Present amt}
-            CooldownQueue ref ->
-                let old = eagerBufferedDeref ref
-                    oldPrePreCooldown = prePreCooldown old
-                    newPrePreCooldown = Present $ ofOption amt (+ amt) oldPrePreCooldown
-                in  old{prePreCooldown = newPrePreCooldown}
-    newRef <- refMake $! newCooldowns
-    return $! ed{paedStakeCooldown = CooldownQueue newRef}
-
-releaseCooldownAmount ::
-    forall m av.
+    newStakeCooldown <- CooldownQueue.addPrePreCooldown amt (paedStakeCooldown ed)
+    return $! ed{paedStakeCooldown = newStakeCooldown}
+
+-- | Remove up to the given amount from the cooldowns, starting with pre-pre-cooldown, then
+--  pre-cooldown, and finally from the amounts in cooldown, in decreasing order of timestamp.
+reactivateCooldownAmount ::
     ( MonadBlobStore m,
       IsAccountVersion av,
       AccountStructureVersionFor av ~ 'AccountStructureV1,
-      SupportsFlexibleCooldown av ~ 'True
+      AVSupportsFlexibleCooldown av
     ) =>
     Amount ->
     PersistentAccount av ->
     m (PersistentAccount av)
-releaseCooldownAmount amt = updateEnduringData $ \ed -> do
-    let newCooldowns = case paedStakeCooldown ed of
-            EmptyCooldownQueue -> emptyCooldowns
-            CooldownQueue ref ->
-                let old = eagerBufferedDeref ref
-                    oldPrePreCooldown = prePreCooldown old
-                    (newPrePreCooldown, leftover1) = preHelper amt oldPrePreCooldown
-                    new = old{prePreCooldown = newPrePreCooldown}
-                    oldPreCooldown = preCooldown old
-                    (new2, leftover2) =
-                        if leftover1 > 0
-                            then
-                                let (newPreCooldown, leftover) = preHelper leftover1 oldPreCooldown
-                                in  (new{preCooldown = newPreCooldown}, leftover)
-                            else (new, 0)
-                    oldCooldown = inCooldown old
-                    new3 =
-                        if leftover2 > 0
-                            then
-                                let newMap = Map.fromAscList $ releaseHelper leftover2 $ Map.toAscList oldCooldown
-                                in  new2{inCooldown = newMap}
-                            else new2
-                in  new3
-    newRef <- refMake $! newCooldowns
-    return $! ed{paedStakeCooldown = CooldownQueue newRef}
+reactivateCooldownAmount amt acc = case paedStakeCooldown (enduringData acc) of
+    EmptyCooldownQueue -> return acc
+    _ -> updateEnduringData reactivate acc
   where
-    releaseHelper :: Amount -> [(Timestamp, Amount)] -> [(Timestamp, Amount)]
-    releaseHelper left orig@((ts, amount) : cooldowns)
-        | left == 0 = orig
-        | left >= amount = releaseHelper (left - amount) cooldowns
-        | otherwise = (ts, amount - left) : cooldowns
-    releaseHelper _ [] = []
-    preHelper :: Amount -> Option Amount -> (Option Amount, Amount)
-    preHelper left optAmt = case optAmt of
-        Absent -> (Absent, left)
-        Present amount ->
-            if left >= amount
-                then (Absent, left - amount)
-                else (Present (amount - left), 0)
+    reactivate ed = do
+        newStakeCooldown <- CooldownQueue.reactivateCooldownAmount amt (paedStakeCooldown ed)
+        return $! ed{paedStakeCooldown = newStakeCooldown}
 
 -- | Set whether a baker or delegator account restakes its earnings.
 --  This MUST only be called with an account that is either a baker or delegator.
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
index aae15fa65..543535d3c 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
@@ -1545,65 +1545,65 @@ doConfigureBaker pbs ai BakerConfigureAdd{..} = do
             let capitalMin = poolParams ^. ppMinimumEquityCapital
             let ranges = poolParams ^. ppCommissionBounds
             if
-                    | bcaCapital < capitalMin -> return (BCStakeUnderThreshold, pbs)
-                    | not (isInRange bcaTransactionFeeCommission (ranges ^. transactionCommissionRange)) ->
-                        return (BCTransactionFeeCommissionNotInRange, pbs)
-                    | not (isInRange bcaBakingRewardCommission (ranges ^. bakingCommissionRange)) ->
-                        return (BCBakingRewardCommissionNotInRange, pbs)
-                    | not (isInRange bcaFinalizationRewardCommission (ranges ^. finalizationCommissionRange)) ->
-                        return (BCFinalizationRewardCommissionNotInRange, pbs)
-                    | otherwise -> do
-                        let bid = BakerId ai
-                        oldPAB <- refLoad (_birkActiveBakers (bspBirkParameters bsp))
-                        maybeDel <- accountDelegator acc
-                        pab <- maybeRemoveDelegator (sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv))) maybeDel oldPAB
-                        let updAgg Nothing = return (True, Trie.Insert ())
-                            updAgg (Just ()) = return (False, Trie.NoChange)
-                        Trie.adjust updAgg (bkuAggregationKey bcaKeys) (_aggregationKeys pab) >>= \case
-                            -- Aggregation key is a duplicate
-                            (False, _) -> return (BCDuplicateAggregationKey (bkuAggregationKey bcaKeys), pbs)
-                            (True, newAggregationKeys) -> do
-                                newActiveBakers <- Trie.insert bid emptyPersistentActiveDelegators (_activeBakers pab)
-                                newpabref <-
-                                    refMake
-                                        PersistentActiveBakers
-                                            { _aggregationKeys = newAggregationKeys,
-                                              _activeBakers = newActiveBakers,
-                                              _passiveDelegators = pab ^. passiveDelegators,
-                                              _totalActiveCapital = addActiveCapital bcaCapital (_totalActiveCapital pab)
-                                            }
-                                let newBirkParams = bspBirkParameters bsp & birkActiveBakers .~ newpabref
-                                let cr =
-                                        CommissionRates
-                                            { _finalizationCommission = bcaFinalizationRewardCommission,
-                                              _bakingCommission = bcaBakingRewardCommission,
-                                              _transactionCommission = bcaTransactionFeeCommission
-                                            }
-                                    poolInfo =
-                                        BaseAccounts.BakerPoolInfo
-                                            { _poolOpenStatus = bcaOpenForDelegation,
-                                              _poolMetadataUrl = bcaMetadataURL,
-                                              _poolCommissionRates = cr
-                                            }
-                                    bakerInfo = bakerKeyUpdateToInfo bid bcaKeys
-                                    bakerInfoEx =
-                                        BaseAccounts.BakerInfoExV1
-                                            { _bieBakerPoolInfo = poolInfo,
-                                              _bieBakerInfo = bakerInfo
-                                            }
-                                    updAcc = addAccountBakerV1 bakerInfoEx bcaCapital bcaRestakeEarnings
-                                newBSP <-
-                                    updateAccountsAndMaybeCooldown
-                                        (sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv)))
-                                        acc
-                                        maybeDel
-                                        updAcc
-                                        bcaCapital
-                                        bsp{bspBirkParameters = newBirkParams}
-                                (BCSuccess [] bid,)
-                                    <$> storePBS
-                                        pbs
-                                        newBSP
+                | bcaCapital < capitalMin -> return (BCStakeUnderThreshold, pbs)
+                | not (isInRange bcaTransactionFeeCommission (ranges ^. transactionCommissionRange)) ->
+                    return (BCTransactionFeeCommissionNotInRange, pbs)
+                | not (isInRange bcaBakingRewardCommission (ranges ^. bakingCommissionRange)) ->
+                    return (BCBakingRewardCommissionNotInRange, pbs)
+                | not (isInRange bcaFinalizationRewardCommission (ranges ^. finalizationCommissionRange)) ->
+                    return (BCFinalizationRewardCommissionNotInRange, pbs)
+                | otherwise -> do
+                    let bid = BakerId ai
+                    oldPAB <- refLoad (_birkActiveBakers (bspBirkParameters bsp))
+                    maybeDel <- accountDelegator acc
+                    pab <- maybeRemoveDelegator (sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv))) maybeDel oldPAB
+                    let updAgg Nothing = return (True, Trie.Insert ())
+                        updAgg (Just ()) = return (False, Trie.NoChange)
+                    Trie.adjust updAgg (bkuAggregationKey bcaKeys) (_aggregationKeys pab) >>= \case
+                        -- Aggregation key is a duplicate
+                        (False, _) -> return (BCDuplicateAggregationKey (bkuAggregationKey bcaKeys), pbs)
+                        (True, newAggregationKeys) -> do
+                            newActiveBakers <- Trie.insert bid emptyPersistentActiveDelegators (_activeBakers pab)
+                            newpabref <-
+                                refMake
+                                    PersistentActiveBakers
+                                        { _aggregationKeys = newAggregationKeys,
+                                          _activeBakers = newActiveBakers,
+                                          _passiveDelegators = pab ^. passiveDelegators,
+                                          _totalActiveCapital = addActiveCapital bcaCapital (_totalActiveCapital pab)
+                                        }
+                            let newBirkParams = bspBirkParameters bsp & birkActiveBakers .~ newpabref
+                            let cr =
+                                    CommissionRates
+                                        { _finalizationCommission = bcaFinalizationRewardCommission,
+                                          _bakingCommission = bcaBakingRewardCommission,
+                                          _transactionCommission = bcaTransactionFeeCommission
+                                        }
+                                poolInfo =
+                                    BaseAccounts.BakerPoolInfo
+                                        { _poolOpenStatus = bcaOpenForDelegation,
+                                          _poolMetadataUrl = bcaMetadataURL,
+                                          _poolCommissionRates = cr
+                                        }
+                                bakerInfo = bakerKeyUpdateToInfo bid bcaKeys
+                                bakerInfoEx =
+                                    BaseAccounts.BakerInfoExV1
+                                        { _bieBakerPoolInfo = poolInfo,
+                                          _bieBakerInfo = bakerInfo
+                                        }
+                                updAcc = addAccountBakerV1 bakerInfoEx bcaCapital bcaRestakeEarnings
+                            newBSP <-
+                                updateAccountsAndMaybeCooldown
+                                    (sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv)))
+                                    acc
+                                    maybeDel
+                                    updAcc
+                                    bcaCapital
+                                    bsp{bspBirkParameters = newBirkParams}
+                            (BCSuccess [] bid,)
+                                <$> storePBS
+                                    pbs
+                                    newBSP
   where
     maybeRemoveDelegator ::
         SBool (SupportsFlexibleCooldown (AccountVersionFor pv)) ->
@@ -1643,17 +1643,13 @@ doConfigureBaker pbs ai BakerConfigureAdd{..} = do
         case maybeDel of
             Nothing -> do
                 maybeCooldownsBefore <- accountCooldowns acc
-                newAcc <- (updAcc >=> releaseCooldownAmount capital) acc
+                newAcc <- (updAcc >=> reactivateCooldownAmount capital) acc
                 -- This cannot fail to update the account, since we already looked up the account.
                 newAccounts <- Accounts.setAccountAtIndex ai newAcc (bspAccounts bsp)
                 maybeCooldownsAfter <- accountCooldowns newAcc
-                let accountsInCooldownForPV = bspAccountsInCooldown bsp
-                let oldAccountsInCooldown = case theAccountsInCooldownForPV accountsInCooldownForPV of
-                        CTrue accounts -> accounts
-                maybeCooldowns <- releaseCooldownGlobally ai oldAccountsInCooldown maybeCooldownsBefore maybeCooldownsAfter
-                case maybeCooldowns of
-                    Nothing -> return bsp{bspAccounts = newAccounts}
-                    Just newCooldowns -> return bsp{bspAccounts = newAccounts, bspAccountsInCooldown = newCooldowns}
+                let removals = cooldownRemovals maybeCooldownsBefore maybeCooldownsAfter
+                newCooldowns <- applyCooldownRemovalsGlobally ai removals (bspAccountsInCooldown bsp)
+                return bsp{bspAccounts = newAccounts, bspAccountsInCooldown = newCooldowns}
             Just del -> do
                 case compare capital (BaseAccounts._delegationStakedAmount del) of
                     LT -> do
@@ -1693,16 +1689,12 @@ doConfigureBaker pbs ai BakerConfigureAdd{..} = do
                     GT -> do
                         maybeCooldownsBefore <- accountCooldowns acc
                         -- This cannot fail to update the account, since we already looked up the account.
-                        newAcc <- (updAcc >=> releaseCooldownAmount (capital - BaseAccounts._delegationStakedAmount del)) acc
+                        newAcc <- (updAcc >=> reactivateCooldownAmount (capital - BaseAccounts._delegationStakedAmount del)) acc
                         newAccounts <- Accounts.setAccountAtIndex ai newAcc (bspAccounts bsp)
                         maybeCooldownsAfter <- accountCooldowns newAcc
-                        let accountsInCooldownForPV = bspAccountsInCooldown bsp
-                        let oldAccountsInCooldown = case theAccountsInCooldownForPV accountsInCooldownForPV of
-                                CTrue accounts -> accounts
-                        maybeCooldowns <- releaseCooldownGlobally ai oldAccountsInCooldown maybeCooldownsBefore maybeCooldownsAfter
-                        case maybeCooldowns of
-                            Nothing -> return bsp{bspAccounts = newAccounts}
-                            Just newCooldowns -> return bsp{bspAccounts = newAccounts, bspAccountsInCooldown = newCooldowns}
+                        let removals = cooldownRemovals maybeCooldownsBefore maybeCooldownsAfter
+                        newCooldowns <- applyCooldownRemovalsGlobally ai removals (bspAccountsInCooldown bsp)
+                        return bsp{bspAccounts = newAccounts, bspAccountsInCooldown = newCooldowns}
 doConfigureBaker pbs ai BakerConfigureUpdate{..} = do
     origBSP <- loadPBS pbs
     cp <- lookupCurrentParameters (bspUpdates origBSP)
@@ -1989,7 +1981,7 @@ doConfigureBaker pbs ai BakerConfigureUpdate{..} = do
                                             %~ addActiveCapital (capital - _stakedAmount oldBkr)
                         MTL.modify' $ \bsp -> bsp{bspBirkParameters = birkParams & birkActiveBakers .~ newActiveBkrs}
                         MTL.tell [BakerConfigureStakeIncreased capital]
-                        return $ setAccountStake capital >=> releaseCooldownAmount (capital - _stakedAmount oldBkr)
+                        return $ setAccountStake capital >=> reactivateCooldownAmount (capital - _stakedAmount oldBkr)
     maybeReleaseCooldownGlobally ::
         SBool (SupportsFlexibleCooldown (AccountVersionFor pv)) ->
         (PersistentAccount (AccountVersionFor pv) -> m (PersistentAccount (AccountVersionFor pv))) ->
@@ -2007,15 +1999,12 @@ doConfigureBaker pbs ai BakerConfigureUpdate{..} = do
         newAcc <- liftBSO $ upd acc
         setAccount newAcc
         maybeCooldownsAfter <- accountCooldowns newAcc
-        accountsInCooldownForPV <- MTL.gets bspAccountsInCooldown
-        let oldAccountsInCooldown = case theAccountsInCooldownForPV accountsInCooldownForPV of
-                CTrue accounts -> accounts
-        maybeCooldowns <- releaseCooldownGlobally ai oldAccountsInCooldown maybeCooldownsBefore maybeCooldownsAfter
-        forM_ maybeCooldowns $ \newCooldowns ->
-            MTL.modify' $ \bsp ->
-                bsp
-                    { bspAccountsInCooldown = newCooldowns
-                    }
+        let removals = cooldownRemovals maybeCooldownsBefore maybeCooldownsAfter
+        newCooldowns <- applyCooldownRemovalsGlobally ai removals =<< MTL.gets bspAccountsInCooldown
+        MTL.modify' $ \bsp ->
+            bsp
+                { bspAccountsInCooldown = newCooldowns
+                }
 
 doConstrainBakerCommission ::
     (SupportsPersistentState pv m, PVSupportsDelegation pv) =>
@@ -2147,17 +2136,13 @@ doConfigureDelegation pbs ai DelegationConfigureAdd{..} = do
                               BaseAccounts._delegationPendingChange = BaseAccounts.NoChange
                             }
                 maybeCooldownsBefore <- accountCooldowns acc
-                newAcc <- (addAccountDelegator dlg >=> releaseCooldownAmount dcaCapital) acc
+                newAcc <- (addAccountDelegator dlg >=> reactivateCooldownAmount dcaCapital) acc
                 maybeCooldownsAfter <- accountCooldowns newAcc
                 -- This cannot fail to update the accounts, since we already looked up the accounts:
                 newAccounts <- lift $ Accounts.setAccountAtIndex ai newAcc (bspAccounts bsp)
-                let accountsInCooldownForPV = bspAccountsInCooldown bsp
-                let oldAccountsInCooldown = case theAccountsInCooldownForPV accountsInCooldownForPV of
-                        CTrue accounts -> accounts
-                maybeCooldowns <- releaseCooldownGlobally ai oldAccountsInCooldown maybeCooldownsBefore maybeCooldownsAfter
-                case maybeCooldowns of
-                    Nothing -> return bsp{bspBirkParameters = newBirkParams, bspAccounts = newAccounts}
-                    Just newCooldowns -> return bsp{bspBirkParameters = newBirkParams, bspAccounts = newAccounts, bspAccountsInCooldown = newCooldowns}
+                let removals = cooldownRemovals maybeCooldownsBefore maybeCooldownsAfter
+                newCooldowns <- applyCooldownRemovalsGlobally ai removals (bspAccountsInCooldown bsp)
+                return bsp{bspBirkParameters = newBirkParams, bspAccounts = newAccounts, bspAccountsInCooldown = newCooldowns}
     updateBirk ::
         BlockStatePointers pv ->
         DelegationTarget ->
@@ -2374,21 +2359,17 @@ doConfigureDelegation pbs ai DelegationConfigureUpdate{..} = do
                         ab <- refLoad (bspBirkParameters bsp1 ^. birkActiveBakers)
                         newActiveBakers <- addTotalsInActiveBakers ab ad (capital - BaseAccounts._delegationStakedAmount ad)
                         maybeCooldownsBefore <- accountCooldowns acc
-                        let accUpd = setAccountStake capital >=> releaseCooldownAmount (capital - BaseAccounts._delegationStakedAmount ad)
+                        let accUpd = setAccountStake capital >=> reactivateCooldownAmount (capital - BaseAccounts._delegationStakedAmount ad)
                         newAcc <- accUpd acc
                         setAccount newAcc
                         maybeCooldownsAfter <- accountCooldowns newAcc
-                        accountsInCooldownForPV <- MTL.gets bspAccountsInCooldown
-                        let oldAccountsInCooldown = case theAccountsInCooldownForPV accountsInCooldownForPV of
-                                CTrue accounts -> accounts
-                        maybeCooldowns <- releaseCooldownGlobally ai oldAccountsInCooldown maybeCooldownsBefore maybeCooldownsAfter
-                        case maybeCooldowns of
-                            Nothing -> MTL.modify' $ \bsp -> bsp{bspBirkParameters = bspBirkParameters bsp1 & birkActiveBakers .~ newActiveBakers}
-                            Just newCooldowns -> MTL.modify' $ \bsp ->
-                                bsp
-                                    { bspBirkParameters = bspBirkParameters bsp1 & birkActiveBakers .~ newActiveBakers,
-                                      bspAccountsInCooldown = newCooldowns
-                                    }
+                        let removals = cooldownRemovals maybeCooldownsBefore maybeCooldownsAfter
+                        newCooldowns <- applyCooldownRemovalsGlobally ai removals (bspAccountsInCooldown bsp1)
+                        MTL.modify' $ \bsp ->
+                            bsp
+                                { bspBirkParameters = bspBirkParameters bsp1 & birkActiveBakers .~ newActiveBakers,
+                                  bspAccountsInCooldown = newCooldowns
+                                }
                         MTL.tell [DelegationConfigureStakeIncreased capital]
         return $ BaseAccounts._delegationStakedAmount ad
     addTotalsInActiveBakers ab0 ad delta = do
@@ -2442,59 +2423,51 @@ doConfigureDelegation pbs ai DelegationConfigureUpdate{..} = do
             (Nothing, Just newTarget) -> unless (newTarget == oldTarget) doCheckOverDelegation
             _ -> return ()
 
-releaseCooldownGlobally ::
-    (MonadBlobStore m, SupportsFlexibleCooldown (AccountVersionFor pv) ~ 'True) =>
+data CooldownRemovals = CooldownRemovals
+    { -- | Whether the pre-pre cooldown was removed.
+      crPrePreCooldown :: Bool,
+      -- | Whether the pre cooldown was removed.
+      crPreCooldown :: Bool,
+      -- | If all cooldowns were removed, this is the previous timestamp of the earliest cooldown.
+      crCooldown :: Maybe Timestamp
+    }
+
+-- | Determine if a change in cooldowns requires global updates to the indexes.
+--  The change should arise from (possibly) reactivating stake from cooldown.
+cooldownRemovals ::
+    Maybe CooldownQueue.Cooldowns -> Maybe CooldownQueue.Cooldowns -> CooldownRemovals
+cooldownRemovals Nothing _ = CooldownRemovals False False Nothing
+cooldownRemovals (Just cd1) Nothing =
+    CooldownRemovals
+        { crPrePreCooldown = isPresent (CooldownQueue.prePreCooldown cd1),
+          crPreCooldown = isPresent (CooldownQueue.preCooldown cd1),
+          crCooldown = fst <$> Map.lookupMin (CooldownQueue.inCooldown cd1)
+        }
+cooldownRemovals (Just cd1) (Just cd2) =
+    CooldownRemovals
+        { crPrePreCooldown = isPresent (CooldownQueue.prePreCooldown cd1) && isAbsent (CooldownQueue.prePreCooldown cd2),
+          crPreCooldown = isPresent (CooldownQueue.preCooldown cd1) && isAbsent (CooldownQueue.preCooldown cd2),
+          crCooldown = do
+            guard (Map.null (CooldownQueue.inCooldown cd2))
+            fst <$> Map.lookupMin (CooldownQueue.inCooldown cd1)
+        }
+
+-- | Apply cooldown removals for an account to the global indexes.
+applyCooldownRemovalsGlobally ::
+    (MonadBlobStore m, PVSupportsFlexibleCooldown pv) =>
     AccountIndex ->
-    AccountsInCooldown ->
-    Maybe CooldownQueue.Cooldowns ->
-    Maybe CooldownQueue.Cooldowns ->
-    m (Maybe (AccountsInCooldownForPV pv))
-releaseCooldownGlobally ai oldAccountsInCooldown maybeCooldownsBefore maybeCooldownsAfter = do
-    let (shouldRemovePrePre, shouldRemovePre, shouldRemoveCooldown, shouldUpdateCooldown) =
-            case (maybeCooldownsBefore, maybeCooldownsAfter) of
-                (Just cd, Nothing) ->
-                    ( isPresent $ CooldownQueue.prePreCooldown cd,
-                      isPresent $ CooldownQueue.preCooldown cd,
-                      Map.lookupMin (CooldownQueue.inCooldown cd),
-                      Nothing
-                    )
-                (Just cd1, Just cd2) ->
-                    ( isPresent (CooldownQueue.prePreCooldown cd1) && isAbsent (CooldownQueue.prePreCooldown cd2),
-                      isPresent (CooldownQueue.preCooldown cd1) && isAbsent (CooldownQueue.preCooldown cd2),
-                      if Map.null (CooldownQueue.inCooldown cd2) then Map.lookupMin (CooldownQueue.inCooldown cd1) else Nothing,
-                      case (Map.lookupMin (CooldownQueue.inCooldown cd1), Map.lookupMin (CooldownQueue.inCooldown cd2)) of
-                        (Just (ts1, _), Just (ts2, _)) -> if ts1 /= ts2 then Just (ts1, ts2) else Nothing
-                        _ -> Nothing
-                    ) -- FIXME: refactor this with the stuff in configure baker
-                _ -> (False, False, Nothing, Nothing)
-    if (shouldRemovePrePre, shouldRemovePre, shouldRemoveCooldown, shouldUpdateCooldown) == (False, False, Nothing, Nothing)
-        then return Nothing
-        else do
-            newAccountsInCooldown1 <-
-                if shouldRemovePrePre
-                    then do
-                        newPrePreCooldown <- removeAccountFromAccountList ai $ _prePreCooldown oldAccountsInCooldown
-                        return oldAccountsInCooldown{_prePreCooldown = newPrePreCooldown}
-                    else return oldAccountsInCooldown
-            newAccountsInCooldown2 <-
-                if shouldRemovePre
-                    then do
-                        newPreCooldown <- removeAccountFromAccountList ai $ _preCooldown oldAccountsInCooldown
-                        return newAccountsInCooldown1{_preCooldown = newPreCooldown}
-                    else return newAccountsInCooldown1
-            newAccountsInCooldown3 <-
-                case shouldRemoveCooldown of
-                    Just (ts, _) -> do
-                        newCooldown <- removeAccountFromReleaseSchedule ts ai $ _cooldown oldAccountsInCooldown
-                        return newAccountsInCooldown2{_cooldown = newCooldown}
-                    Nothing -> return newAccountsInCooldown2
-            newAccountsInCooldown4 <-
-                case shouldUpdateCooldown of
-                    Just (ts1, ts2) -> do
-                        newCooldown <- updateAccountRelease ts1 ts2 ai $ _cooldown oldAccountsInCooldown
-                        return newAccountsInCooldown3{_cooldown = newCooldown}
-                    Nothing -> return newAccountsInCooldown3
-            return $ Just $ AccountsInCooldownForPV $ CTrue newAccountsInCooldown4
+    CooldownRemovals ->
+    AccountsInCooldownForPV pv ->
+    m (AccountsInCooldownForPV pv)
+applyCooldownRemovalsGlobally ai CooldownRemovals{..} =
+    doIf crPrePreCooldown ((accountsInCooldown . prePreCooldown) (removeAccountFromAccountList ai))
+        >=> doIf crPreCooldown ((accountsInCooldown . preCooldown) (removeAccountFromAccountList ai))
+        >=> case crCooldown of
+            Just ts -> (accountsInCooldown . cooldown) (removeAccountFromReleaseSchedule ts ai)
+            Nothing -> return
+  where
+    doIf True f = f
+    doIf False _ = return
 
 doUpdateBakerKeys ::
     (SupportsPersistentState pv m, AccountVersionFor pv ~ 'AccountV0) =>
@@ -2763,8 +2736,8 @@ doMint pbs mint = do
             bspBank bsp
                 & unhashed
                     %~ (Rewards.totalGTU +~ mintTotal mint)
-                    . (Rewards.bakingRewardAccount +~ mintBakingReward mint)
-                    . (Rewards.finalizationRewardAccount +~ mintFinalizationReward mint)
+                        . (Rewards.bakingRewardAccount +~ mintBakingReward mint)
+                        . (Rewards.finalizationRewardAccount +~ mintFinalizationReward mint)
     let updAcc = addAccountAmount $ mintDevelopmentCharge mint
     foundationAccount <- (^. cpFoundationAccount) <$> lookupCurrentParameters (bspUpdates bsp)
     newAccounts <- Accounts.updateAccountsAtIndex' updAcc foundationAccount (bspAccounts bsp)
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Cooldown.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Cooldown.hs
index afcc8a69f..2c0bd15bb 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Cooldown.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Cooldown.hs
@@ -86,8 +86,11 @@ removeAccountFromAccountList ai alist = case alist of
 
 -- | This is an indexing structure and therefore does not need to be hashed. FIXME: add more docs
 data AccountsInCooldown = AccountsInCooldown
-    { _cooldown :: !NewReleaseSchedule,
+    { -- | The accounts that are in cooldown with their earliest release times.
+      _cooldown :: !NewReleaseSchedule,
+      -- | The accounts that are in pre-cooldown.
       _preCooldown :: !AccountList,
+      -- | The accounts that are in pre-pre-cooldown.
       _prePreCooldown :: !AccountList
     }
 
diff --git a/concordium-consensus/tests/globalstate/GlobalStateTests/CooldownQueue.hs b/concordium-consensus/tests/globalstate/GlobalStateTests/CooldownQueue.hs
index 89280ae95..88da837e2 100644
--- a/concordium-consensus/tests/globalstate/GlobalStateTests/CooldownQueue.hs
+++ b/concordium-consensus/tests/globalstate/GlobalStateTests/CooldownQueue.hs
@@ -60,6 +60,58 @@ cooldown2 = cooldown1{preCooldown = Absent}
 cooldown3 :: Cooldowns
 cooldown3 = cooldown2{prePreCooldown = Absent}
 
+testReactivateCooldownAmount :: Assertion
+testReactivateCooldownAmount = do
+    assertEqual "reactivate 0" cooldown1 (reactivateCooldownAmount 0 cooldown1)
+    assertEqual
+        "reactivate 10"
+        cooldown1{prePreCooldown = Present 1990}
+        (reactivateCooldownAmount 10 cooldown1)
+    assertEqual
+        "reactivate 2000"
+        cooldown1{prePreCooldown = Absent}
+        (reactivateCooldownAmount 2000 cooldown1)
+    assertEqual
+        "reactivate 2010"
+        cooldown1{prePreCooldown = Absent, preCooldown = Present 140}
+        (reactivateCooldownAmount 2010 cooldown1)
+    assertEqual
+        "reactivate 2150"
+        cooldown3
+        (reactivateCooldownAmount 2150 cooldown1)
+    assertEqual
+        "reactivate 2200"
+        cooldown3{inCooldown = Map.fromList [(Timestamp 10, 1), (Timestamp 20, 15), (Timestamp 30, 50)]}
+        (reactivateCooldownAmount 2200 cooldown1)
+    assertEqual
+        "reactivate 2250"
+        cooldown3{inCooldown = Map.fromList [(Timestamp 10, 1), (Timestamp 20, 15)]}
+        (reactivateCooldownAmount 2250 cooldown1)
+    assertEqual
+        "reactivate 2255"
+        cooldown3{inCooldown = Map.fromList [(Timestamp 10, 1), (Timestamp 20, 10)]}
+        (reactivateCooldownAmount 2255 cooldown1)
+    assertEqual
+        "reactivate 2265"
+        cooldown3{inCooldown = Map.fromList [(Timestamp 10, 1)]}
+        (reactivateCooldownAmount 2265 cooldown1)
+    assertEqual
+        "reactivate 2266"
+        emptyCooldowns
+        (reactivateCooldownAmount 2266 cooldown1)
+    assertEqual
+        "reactivate 5000"
+        emptyCooldowns
+        (reactivateCooldownAmount 5000 cooldown1)
+    assertEqual
+        "reactivate 2050 (cooldown2)"
+        cooldown3{inCooldown = Map.fromList [(Timestamp 10, 1), (Timestamp 20, 15), (Timestamp 30, 50)]}
+        (reactivateCooldownAmount 2050 cooldown2)
+    assertEqual
+        "reactivate 50 (cooldown 3)"
+        cooldown3{inCooldown = Map.fromList [(Timestamp 10, 1), (Timestamp 20, 15), (Timestamp 30, 50)]}
+        (reactivateCooldownAmount 50 cooldown3)
+
 -- | Unit test for 'processCooldowns'.
 testProcessCooldowns :: Assertion
 testProcessCooldowns = do
@@ -187,6 +239,22 @@ testToCooldownList = do
         ]
         (toCooldownList ccp2 cooldown1)
 
+testAddPrePreCooldownEmpty :: Assertion
+testAddPrePreCooldownEmpty = do
+    let amount = 100
+    let newCooldowns = addPrePreCooldown amount emptyCooldowns
+    assertEqual "pre-pre-cooldown" (Present amount) (prePreCooldown newCooldowns)
+    assertEqual "pre-cooldown" Absent (preCooldown newCooldowns)
+    assertEqual "in-cooldown" Map.empty (inCooldown newCooldowns)
+
+testAddPrePreCooldownNonEmpty :: Assertion
+testAddPrePreCooldownNonEmpty = do
+    let amount = 100
+    let newCooldowns = addPrePreCooldown amount cooldown1
+    assertEqual "pre-pre-cooldown" (Present $ 2000 + amount) (prePreCooldown newCooldowns)
+    assertEqual "pre-cooldown" (preCooldown cooldown1) (preCooldown newCooldowns)
+    assertEqual "in-cooldown" (inCooldown cooldown1) (inCooldown newCooldowns)
+
 tests :: Spec
 tests = describe "GlobalStateTests.CooldownQueue" $ parallel $ do
     it "Cooldowns serialization" $ withMaxSuccess 1000 testSerialize
@@ -200,3 +268,6 @@ tests = describe "GlobalStateTests.CooldownQueue" $ parallel $ do
     it "preCooldownTimestamp" testPreCooldownTimestamp
     it "prePreCooldownTimestamp" testPrePreCooldownTimestamp
     it "toCooldownList" testToCooldownList
+    it "addPrePreCooldown empty" testAddPrePreCooldownEmpty
+    it "addPrePreCooldown non-empty" testAddPrePreCooldownNonEmpty
+    it "reactivateCooldownAmount" testReactivateCooldownAmount

From 69b465dc124a88968c1d4e8d184540c0603dab08 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Fri, 19 Jul 2024 20:33:57 +0200
Subject: [PATCH 31/81] Start of refactoring for configure baker.

---
 .../src/Concordium/GlobalState/BakerInfo.hs   |  17 ++
 .../GlobalState/Persistent/BlockState.hs      | 165 ++++++++++++++++++
 2 files changed, 182 insertions(+)

diff --git a/concordium-consensus/src/Concordium/GlobalState/BakerInfo.hs b/concordium-consensus/src/Concordium/GlobalState/BakerInfo.hs
index 4275061fb..51b4e70d7 100644
--- a/concordium-consensus/src/Concordium/GlobalState/BakerInfo.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/BakerInfo.hs
@@ -174,6 +174,23 @@ data BakerAddResult
       BAStakeUnderThreshold
     deriving (Eq, Ord, Show)
 
+-- | Parameters for adding a validator.
+data ValidatorAdd = ValidatorAdd
+    { -- | The keys for the baker.
+      vaKeys :: !BakerKeyUpdate,
+      -- | The initial stake.
+      vaCapital :: !Amount,
+      -- | Whether to restake earned rewards
+      vaRestakeEarnings :: !Bool,
+      -- | Whether the validator pool is open for delegation.
+      vaOpenForDelegation :: !OpenStatus,
+      -- | The metadata URL for the validator.
+      vaMetadataURL :: !UrlText,
+      -- | The commission rates for the validator.
+      vaCommissionRates :: !CommissionRates
+    }
+    deriving (Eq, Show)
+
 -- | Data structure used to add/remove/update baker.
 data BakerConfigure
     = -- | Add a baker, all fields are required.
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
index 543535d3c..5ba30cb99 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
@@ -4,6 +4,7 @@
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE EmptyCase #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
@@ -1520,6 +1521,170 @@ redelegatePassive accounts (DelegatorId accId) =
         accId
         accounts
 
+data BakerConfigureFailure
+    = BCFStakeUnderThreshold
+    | BCFTransactionFeeCommissionNotInRange
+    | BCFBakingRewardCommissionNotInRange
+    | BCFFinalizationRewardCommissionNotInRange
+    | BCFDuplicateAggregationKey !BakerAggregationVerifyKey
+    | BCFChangePending
+
+configureBakerChecks ::
+    forall pv m.
+    ( SupportsPersistentState pv m,
+      PoolParametersVersionFor (ChainParametersVersionFor pv) ~ 'PoolParametersVersion1
+    ) =>
+    BlockStatePointers pv ->
+    ChainParameters pv ->
+    PersistentAccount (AccountVersionFor pv) ->
+    BakerConfigure ->
+    MTL.ExceptT BakerConfigureFailure m ()
+configureBakerChecks bsp chainParams _ BakerConfigureAdd{..}
+    -- Check if the equity capital is below the minimum threshold.
+    | bcaCapital < capitalMin = MTL.throwError BCFStakeUnderThreshold
+    -- Check if the transaction fee commission rate is in the acceptable range.
+    | not (isInRange bcaTransactionFeeCommission (ranges ^. transactionCommissionRange)) =
+        MTL.throwError BCFTransactionFeeCommissionNotInRange
+    -- Check if the baking reward commission rate is in the acceptable range.
+    | not (isInRange bcaBakingRewardCommission (ranges ^. bakingCommissionRange)) =
+        MTL.throwError BCFBakingRewardCommissionNotInRange
+    -- Check if the finalization reward commission rate is in the acceptable range.
+    | not (isInRange bcaFinalizationRewardCommission (ranges ^. finalizationCommissionRange)) =
+        MTL.throwError BCFFinalizationRewardCommissionNotInRange
+    | otherwise = do
+        -- Check if the aggregation key is fresh.
+        pab <- refLoad (_birkActiveBakers (bspBirkParameters bsp))
+        existingAggKey <- isJust <$> Trie.lookup (bkuAggregationKey bcaKeys) (_aggregationKeys pab)
+        when existingAggKey $
+            MTL.throwError (BCFDuplicateAggregationKey (bkuAggregationKey bcaKeys))
+  where
+    poolParams = chainParams ^. cpPoolParameters
+    capitalMin = poolParams ^. ppMinimumEquityCapital
+    ranges = poolParams ^. ppCommissionBounds
+configureBakerChecks bsp chainParams acc BakerConfigureUpdate{..} = do
+    -- The account must have a baker in the case of BakerConfigureUpdate.
+    baker <- fromJust <$> accountBaker acc
+    -- Check if the aggregation key is fresh (or the same as the baker's existing one).
+    forM_ bcuKeys $ \BakerKeyUpdate{..} ->
+        when (baker ^. BaseAccounts.bakerAggregationVerifyKey /= bkuAggregationKey) $ do
+            pab <- refLoad (_birkActiveBakers (bspBirkParameters bsp))
+            existingAggKey <- isJust <$> Trie.lookup bkuAggregationKey (_aggregationKeys pab)
+            when existingAggKey $
+                MTL.throwError (BCFDuplicateAggregationKey bkuAggregationKey)
+    -- Check if the transaction fee commission rate is in the acceptable range.
+    forM_ bcuTransactionFeeCommission $ \tfc ->
+        unless (isInRange tfc (ranges ^. transactionCommissionRange)) $
+            MTL.throwError BCFTransactionFeeCommissionNotInRange
+    -- Check if the baking reward commission rate is in the acceptable range.
+    forM_ bcuBakingRewardCommission $ \brc ->
+        unless (isInRange brc (ranges ^. bakingCommissionRange)) $
+            MTL.throwError BCFBakingRewardCommissionNotInRange
+    -- Check if the finalization reward commission rate is in the acceptable range.
+    forM_ bcuFinalizationRewardCommission $ \frc ->
+        unless (isInRange frc (ranges ^. finalizationCommissionRange)) $
+            MTL.throwError BCFFinalizationRewardCommissionNotInRange
+    forM_ bcuCapital $ \capital -> do
+        -- Check that there is no pending change on the account already.
+        case baker ^. BaseAccounts.bakerPendingChange of
+            BaseAccounts.NoChange -> return ()
+            _ -> MTL.throwError BCFChangePending
+        -- Check that the baker's equity capital is above the minimum threshold.
+        when (capital < capitalMin) $
+            MTL.throwError BCFStakeUnderThreshold
+  where
+    poolParams = chainParams ^. cpPoolParameters
+    capitalMin = poolParams ^. ppMinimumEquityCapital
+    ranges = poolParams ^. ppCommissionBounds
+
+addValidatorChecks ::
+    forall pv m.
+    ( SupportsPersistentState pv m,
+      PoolParametersVersionFor (ChainParametersVersionFor pv) ~ 'PoolParametersVersion1
+    ) =>
+    BlockStatePointers pv ->
+    ChainParameters pv ->
+    ValidatorAdd ->
+    MTL.ExceptT BakerConfigureFailure m ()
+addValidatorChecks bsp chainParams ValidatorAdd{..}
+    -- Check if the equity capital is below the minimum threshold.
+    | vaCapital < capitalMin = MTL.throwError BCFStakeUnderThreshold
+    -- Check if the transaction fee commission rate is in the acceptable range.
+    | not (isInRange (vaCommissionRates ^. transactionCommission) (ranges ^. transactionCommissionRange)) =
+        MTL.throwError BCFTransactionFeeCommissionNotInRange
+    -- Check if the baking reward commission rate is in the acceptable range.
+    | not (isInRange (vaCommissionRates ^. bakingCommission) (ranges ^. bakingCommissionRange)) =
+        MTL.throwError BCFBakingRewardCommissionNotInRange
+    -- Check if the finalization reward commission rate is in the acceptable range.
+    | not (isInRange (vaCommissionRates ^. finalizationCommission) (ranges ^. finalizationCommissionRange)) =
+        MTL.throwError BCFFinalizationRewardCommissionNotInRange
+    | otherwise = do
+        -- Check if the aggregation key is fresh.
+        pab <- refLoad (_birkActiveBakers (bspBirkParameters bsp))
+        existingAggKey <- isJust <$> Trie.lookup (bkuAggregationKey vaKeys) (_aggregationKeys pab)
+        when existingAggKey $
+            MTL.throwError (BCFDuplicateAggregationKey (bkuAggregationKey vaKeys))
+  where
+    poolParams = chainParams ^. cpPoolParameters
+    capitalMin = poolParams ^. ppMinimumEquityCapital
+    ranges = poolParams ^. ppCommissionBounds
+
+newConfigureValidatorAdd ::
+    forall pv m.
+    ( SupportsPersistentState pv m,
+      PVSupportsDelegation pv,
+      IsSupported 'PTTimeParameters (ChainParametersVersionFor pv) ~ 'True,
+      PoolParametersVersionFor (ChainParametersVersionFor pv) ~ 'PoolParametersVersion1,
+      CooldownParametersVersionFor (ChainParametersVersionFor pv) ~ 'CooldownParametersVersion1
+    ) =>
+    PersistentBlockState (MPV m) ->
+    AccountIndex ->
+    ValidatorAdd ->
+    MTL.ExceptT BakerConfigureFailure m (PersistentBlockState (MPV m))
+newConfigureValidatorAdd pbs ai va@ValidatorAdd{..} = do
+    -- Precondition: the account exists and is not already a baker or a delegator.
+    -- (Before protocol version 7, the account should not be a delegator.)
+    bsp <- loadPBS pbs
+    chainParams <- lookupCurrentParameters (bspUpdates bsp)
+    addValidatorChecks bsp chainParams va
+    pab <- refLoad (bspBirkParameters bsp ^. birkActiveBakers)
+    newAggregationKeys <- Trie.insert (bkuAggregationKey vaKeys) () (pab ^. aggregationKeys)
+    newActiveBakers <- Trie.insert bid emptyPersistentActiveDelegators (pab ^. activeBakers)
+    newPABref <-
+        refMake $
+            pab
+                & aggregationKeys .~ newAggregationKeys
+                & activeBakers .~ newActiveBakers
+                & totalActiveCapital %~ addActiveCapital vaCapital
+    let newBirkParams = bspBirkParameters bsp & birkActiveBakers .~ newPABref
+    let poolInfo =
+            BaseAccounts.BakerPoolInfo
+                { _poolOpenStatus = vaOpenForDelegation,
+                  _poolMetadataUrl = vaMetadataURL,
+                  _poolCommissionRates = vaCommissionRates
+                }
+    let bakerInfo = bakerKeyUpdateToInfo bid vaKeys
+    let bakerInfoEx = BaseAccounts.BakerInfoExV1 bakerInfo poolInfo
+    acc <- fromJust <$> Accounts.indexedAccount ai (bspAccounts bsp)
+    accWithBaker <- addAccountBakerV1 bakerInfoEx vaCapital vaRestakeEarnings acc
+    (accUpdated, newAIC) <- case sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv)) of
+        SFalse -> return (accWithBaker, bspAccountsInCooldown bsp)
+        STrue -> do
+            oldCooldowns <- accountCooldowns accWithBaker
+            accUpdated <- reactivateCooldownAmount vaCapital accWithBaker
+            newCooldowns <- accountCooldowns accUpdated
+            let removals = cooldownRemovals oldCooldowns newCooldowns
+            newAIC <- applyCooldownRemovalsGlobally ai removals (bspAccountsInCooldown bsp)
+            return (accUpdated, newAIC)
+    newAccounts <- Accounts.setAccountAtIndex ai accUpdated (bspAccounts bsp)
+    storePBS pbs $
+        bsp
+            { bspBirkParameters = newBirkParams,
+              bspAccounts = newAccounts,
+              bspAccountsInCooldown = newAIC
+            }
+  where
+    bid = BakerId ai
+
 doConfigureBaker ::
     forall pv m.
     ( SupportsPersistentState pv m,

From 416e94f7481d1314023d326fcc7e12f0d9b5c37e Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Sat, 20 Jul 2024 14:10:26 +0200
Subject: [PATCH 32/81] New configure baker.

---
 .../src/Concordium/GlobalState/BakerInfo.hs   |  24 +-
 .../GlobalState/Persistent/Account.hs         |   9 +
 .../GlobalState/Persistent/BlockState.hs      | 426 ++++++++++++++----
 3 files changed, 371 insertions(+), 88 deletions(-)

diff --git a/concordium-consensus/src/Concordium/GlobalState/BakerInfo.hs b/concordium-consensus/src/Concordium/GlobalState/BakerInfo.hs
index 51b4e70d7..d3a180bb6 100644
--- a/concordium-consensus/src/Concordium/GlobalState/BakerInfo.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/BakerInfo.hs
@@ -176,7 +176,7 @@ data BakerAddResult
 
 -- | Parameters for adding a validator.
 data ValidatorAdd = ValidatorAdd
-    { -- | The keys for the baker.
+    { -- | The keys for the validator.
       vaKeys :: !BakerKeyUpdate,
       -- | The initial stake.
       vaCapital :: !Amount,
@@ -191,6 +191,28 @@ data ValidatorAdd = ValidatorAdd
     }
     deriving (Eq, Show)
 
+-- | Parameters for updating an existing validator. Where a field is 'Nothing', the field is not
+--  updated.
+data ValidatorUpdate = ValidatorUpdate
+    { -- | The new keys for the validator.
+      vuKeys :: !(Maybe BakerKeyUpdate),
+      -- | The new capital for the validator.
+      vuCapital :: !(Maybe Amount),
+      -- | Whether to restake earned rewards.
+      vuRestakeEarnings :: !(Maybe Bool),
+      -- | Whether the validator pool is open for delegation.
+      vuOpenForDelegation :: !(Maybe OpenStatus),
+      -- | The new metadata URL for the validator.
+      vuMetadataURL :: !(Maybe UrlText),
+      -- | The new transaction fee commission for the validator.
+      vuTransactionFeeCommission :: !(Maybe AmountFraction),
+      -- | The new baking reward commission for the validator.
+      vuBakingRewardCommission :: !(Maybe AmountFraction),
+      -- | The new finalization reward commission for the validator.
+      vuFinalizationRewardCommission :: !(Maybe AmountFraction)
+    }
+    deriving (Eq, Show)
+
 -- | Data structure used to add/remove/update baker.
 data BakerConfigure
     = -- | Add a baker, all fields are required.
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs
index 2a295c3d9..571eac63a 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs
@@ -277,6 +277,15 @@ accountCooldowns ::
     m (Maybe Cooldowns)
 accountCooldowns (PAV3 acc) = V1.getCooldowns acc
 
+-- | Determine if an account has a pre-pre-cooldown.
+accountHasPrePreCooldown ::
+    (MonadBlobStore m, AVSupportsFlexibleCooldown av) =>
+    PersistentAccount av ->
+    m Bool
+accountHasPrePreCooldown = fmap check . accountCooldowns
+  where
+    check = maybe False (not . null . prePreCooldown)
+
 -- | Get the 'AccountHash' for the account.
 accountHash :: (MonadBlobStore m) => PersistentAccount av -> m (AccountHash av)
 accountHash (PAV0 acc) = getHashM acc
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
index 5ba30cb99..53d2e863c 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
@@ -1602,33 +1602,46 @@ addValidatorChecks ::
       PoolParametersVersionFor (ChainParametersVersionFor pv) ~ 'PoolParametersVersion1
     ) =>
     BlockStatePointers pv ->
-    ChainParameters pv ->
     ValidatorAdd ->
     MTL.ExceptT BakerConfigureFailure m ()
-addValidatorChecks bsp chainParams ValidatorAdd{..}
+addValidatorChecks bsp ValidatorAdd{..} = do
+    chainParams <- lookupCurrentParameters (bspUpdates bsp)
+    let
+        poolParams = chainParams ^. cpPoolParameters
+        capitalMin = poolParams ^. ppMinimumEquityCapital
+        ranges = poolParams ^. ppCommissionBounds
     -- Check if the equity capital is below the minimum threshold.
-    | vaCapital < capitalMin = MTL.throwError BCFStakeUnderThreshold
+    when (vaCapital < capitalMin) $ MTL.throwError BCFStakeUnderThreshold
     -- Check if the transaction fee commission rate is in the acceptable range.
-    | not (isInRange (vaCommissionRates ^. transactionCommission) (ranges ^. transactionCommissionRange)) =
-        MTL.throwError BCFTransactionFeeCommissionNotInRange
+    unless
+        ( isInRange
+            (vaCommissionRates ^. transactionCommission)
+            (ranges ^. transactionCommissionRange)
+        )
+        $ MTL.throwError BCFTransactionFeeCommissionNotInRange
     -- Check if the baking reward commission rate is in the acceptable range.
-    | not (isInRange (vaCommissionRates ^. bakingCommission) (ranges ^. bakingCommissionRange)) =
-        MTL.throwError BCFBakingRewardCommissionNotInRange
+    unless
+        ( isInRange
+            (vaCommissionRates ^. bakingCommission)
+            (ranges ^. bakingCommissionRange)
+        )
+        $ MTL.throwError BCFBakingRewardCommissionNotInRange
     -- Check if the finalization reward commission rate is in the acceptable range.
-    | not (isInRange (vaCommissionRates ^. finalizationCommission) (ranges ^. finalizationCommissionRange)) =
-        MTL.throwError BCFFinalizationRewardCommissionNotInRange
-    | otherwise = do
-        -- Check if the aggregation key is fresh.
-        pab <- refLoad (_birkActiveBakers (bspBirkParameters bsp))
-        existingAggKey <- isJust <$> Trie.lookup (bkuAggregationKey vaKeys) (_aggregationKeys pab)
-        when existingAggKey $
-            MTL.throwError (BCFDuplicateAggregationKey (bkuAggregationKey vaKeys))
-  where
-    poolParams = chainParams ^. cpPoolParameters
-    capitalMin = poolParams ^. ppMinimumEquityCapital
-    ranges = poolParams ^. ppCommissionBounds
-
-newConfigureValidatorAdd ::
+    unless
+        ( isInRange
+            (vaCommissionRates ^. finalizationCommission)
+            (ranges ^. finalizationCommissionRange)
+        )
+        $ MTL.throwError BCFFinalizationRewardCommissionNotInRange
+    -- Check if the aggregation key is fresh.
+    pab <- refLoad (_birkActiveBakers (bspBirkParameters bsp))
+    existingAggKey <- isJust <$> Trie.lookup (bkuAggregationKey vaKeys) (_aggregationKeys pab)
+    when existingAggKey $
+        MTL.throwError (BCFDuplicateAggregationKey (bkuAggregationKey vaKeys))
+
+-- |
+-- PRECONDITION: The account exists and is not currently a baker or delegator.
+newAddValidator ::
     forall pv m.
     ( SupportsPersistentState pv m,
       PVSupportsDelegation pv,
@@ -1640,12 +1653,9 @@ newConfigureValidatorAdd ::
     AccountIndex ->
     ValidatorAdd ->
     MTL.ExceptT BakerConfigureFailure m (PersistentBlockState (MPV m))
-newConfigureValidatorAdd pbs ai va@ValidatorAdd{..} = do
-    -- Precondition: the account exists and is not already a baker or a delegator.
-    -- (Before protocol version 7, the account should not be a delegator.)
+newAddValidator pbs ai va@ValidatorAdd{..} = do
     bsp <- loadPBS pbs
-    chainParams <- lookupCurrentParameters (bspUpdates bsp)
-    addValidatorChecks bsp chainParams va
+    addValidatorChecks bsp va
     pab <- refLoad (bspBirkParameters bsp ^. birkActiveBakers)
     newAggregationKeys <- Trie.insert (bkuAggregationKey vaKeys) () (pab ^. aggregationKeys)
     newActiveBakers <- Trie.insert bid emptyPersistentActiveDelegators (pab ^. activeBakers)
@@ -1665,10 +1675,12 @@ newConfigureValidatorAdd pbs ai va@ValidatorAdd{..} = do
     let bakerInfo = bakerKeyUpdateToInfo bid vaKeys
     let bakerInfoEx = BaseAccounts.BakerInfoExV1 bakerInfo poolInfo
     acc <- fromJust <$> Accounts.indexedAccount ai (bspAccounts bsp)
+    -- Add the baker to the account.
     accWithBaker <- addAccountBakerV1 bakerInfoEx vaCapital vaRestakeEarnings acc
     (accUpdated, newAIC) <- case sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv)) of
         SFalse -> return (accWithBaker, bspAccountsInCooldown bsp)
         STrue -> do
+            -- Reactivate stake in cooldown to cover the new stake.
             oldCooldowns <- accountCooldowns accWithBaker
             accUpdated <- reactivateCooldownAmount vaCapital accWithBaker
             newCooldowns <- accountCooldowns accUpdated
@@ -1685,6 +1697,246 @@ newConfigureValidatorAdd pbs ai va@ValidatorAdd{..} = do
   where
     bid = BakerId ai
 
+updateValidatorChecks ::
+    forall pv m.
+    ( SupportsPersistentState pv m,
+      PoolParametersVersionFor (ChainParametersVersionFor pv) ~ 'PoolParametersVersion1
+    ) =>
+    BlockStatePointers pv ->
+    AccountBaker (AccountVersionFor pv) ->
+    ValidatorUpdate ->
+    MTL.ExceptT BakerConfigureFailure m ()
+updateValidatorChecks bsp baker ValidatorUpdate{..} = do
+    chainParams <- lookupCurrentParameters (bspUpdates bsp)
+    let
+        poolParams = chainParams ^. cpPoolParameters
+        capitalMin = poolParams ^. ppMinimumEquityCapital
+        ranges = poolParams ^. ppCommissionBounds
+    -- Check if the aggregation key is fresh (or the same as the baker's existing one).
+    forM_ vuKeys $ \BakerKeyUpdate{..} ->
+        when (baker ^. BaseAccounts.bakerAggregationVerifyKey /= bkuAggregationKey) $ do
+            pab <- refLoad (_birkActiveBakers (bspBirkParameters bsp))
+            existingAggKey <- isJust <$> Trie.lookup bkuAggregationKey (_aggregationKeys pab)
+            when existingAggKey $
+                MTL.throwError (BCFDuplicateAggregationKey bkuAggregationKey)
+    -- Check if the transaction fee commission rate is in the acceptable range.
+    forM_ vuTransactionFeeCommission $ \tfc ->
+        unless (isInRange tfc (ranges ^. transactionCommissionRange)) $
+            MTL.throwError BCFTransactionFeeCommissionNotInRange
+    -- Check if the baking reward commission rate is in the acceptable range.
+    forM_ vuBakingRewardCommission $ \brc ->
+        unless (isInRange brc (ranges ^. bakingCommissionRange)) $
+            MTL.throwError BCFBakingRewardCommissionNotInRange
+    -- Check if the finalization reward commission rate is in the acceptable range.
+    forM_ vuFinalizationRewardCommission $ \frc ->
+        unless (isInRange frc (ranges ^. finalizationCommissionRange)) $
+            MTL.throwError BCFFinalizationRewardCommissionNotInRange
+    forM_ vuCapital $ \capital -> do
+        -- Check that there is no pending change on the account already.
+        when (baker ^. BaseAccounts.bakerPendingChange /= BaseAccounts.NoChange) $
+            MTL.throwError BCFChangePending
+        -- Check that the baker's equity capital is above the minimum threshold, unless it
+        -- is being removed.
+        when (capital /= 0 && capital < capitalMin) $
+            MTL.throwError BCFStakeUnderThreshold
+
+newUpdateValidator ::
+    forall pv m.
+    ( SupportsPersistentState pv m,
+      PVSupportsDelegation pv,
+      IsSupported 'PTTimeParameters (ChainParametersVersionFor pv) ~ 'True,
+      PoolParametersVersionFor (ChainParametersVersionFor pv) ~ 'PoolParametersVersion1,
+      CooldownParametersVersionFor (ChainParametersVersionFor pv) ~ 'CooldownParametersVersion1
+    ) =>
+    PersistentBlockState (MPV m) ->
+    -- | Current block timestamp
+    Timestamp ->
+    AccountIndex ->
+    ValidatorUpdate ->
+    MTL.ExceptT BakerConfigureFailure m ([BakerConfigureUpdateChange], PersistentBlockState (MPV m))
+newUpdateValidator pbs curTimestamp ai vu@ValidatorUpdate{..} = do
+    bsp <- loadPBS pbs
+    -- Cannot fail: account must exist.
+    acc <- fromJust <$> Accounts.indexedAccount ai (bspAccounts bsp)
+    -- Cannot fail: account must be a registered baker.
+    existingBaker <- fromJust <$> accountBaker acc
+    updateValidatorChecks bsp existingBaker vu
+    (newBSP, events) <- lift . MTL.runWriterT $ do
+        (newBSP, newAcc) <-
+            updateKeys existingBaker (bsp, acc)
+                >>= updateRestakeEarnings
+                >>= updatePoolInfo existingBaker
+                >>= updateCapital existingBaker
+        newAccounts <- Accounts.setAccountAtIndex ai newAcc (bspAccounts newBSP)
+        return newBSP{bspAccounts = newAccounts}
+    (events,) <$> storePBS pbs newBSP
+  where
+    bid = BakerId ai
+    ifPresent Nothing _ = return
+    ifPresent (Just v) k = k v
+    updateKeys oldBaker = ifPresent vuKeys $ \keys (bsp, acc) -> do
+        let oldAggrKey = oldBaker ^. BaseAccounts.bakerAggregationVerifyKey
+        bsp1 <-
+            if bkuAggregationKey keys == oldAggrKey
+                then return bsp
+                else do
+                    pab <- refLoad (_birkActiveBakers (bspBirkParameters bsp))
+                    newAggregationKeys <-
+                        Trie.insert (bkuAggregationKey keys) ()
+                            =<< Trie.delete oldAggrKey (_aggregationKeys pab)
+                    newPABref <- refMake $ pab & aggregationKeys .~ newAggregationKeys
+                    return $
+                        bsp{bspBirkParameters = bspBirkParameters bsp & birkActiveBakers .~ newPABref}
+        acc1 <- setAccountBakerKeys keys acc
+        MTL.tell [BakerConfigureUpdateKeys keys]
+        return (bsp1, acc1)
+    updateRestakeEarnings = ifPresent vuRestakeEarnings $ \re (bsp, acc) -> do
+        acc1 <- setAccountRestakeEarnings re acc
+        MTL.tell [BakerConfigureRestakeEarnings re]
+        return (bsp, acc1)
+    updatePoolInfo oldBaker (bsp0, acc) = do
+        let pu0 = emptyBakerPoolInfoUpdate
+        (bsp1, pu1) <-
+            updateOpenForDelegation oldBaker (bsp0, pu0)
+                >>= updateMetadataURL oldBaker
+                >>= updateTransactionFeeCommission oldBaker
+                >>= updateBakingRewardCommission oldBaker
+                >>= updateFinalizationRewardCommission oldBaker
+        acc1 <- updateAccountBakerPoolInfo pu1 acc
+        return (bsp1, acc1)
+    updateOpenForDelegation oldBaker = ifPresent vuOpenForDelegation $ \openForDelegation (bsp, pu) -> do
+        MTL.tell [BakerConfigureOpenForDelegation openForDelegation]
+        if oldBaker ^. BaseAccounts.poolOpenStatus == openForDelegation
+            then return (bsp, pu)
+            else do
+                bsp1 <-
+                    if openForDelegation == Transactions.ClosedForAll
+                        then moveDelegatorsToPassive bsp Nothing
+                        else return bsp
+                return (bsp1, pu{updOpenForDelegation = Just openForDelegation})
+    updateMetadataURL oldBaker = ifPresent vuMetadataURL $ \metadataUrl (bsp, pu) -> do
+        MTL.tell [BakerConfigureMetadataURL metadataUrl]
+        if oldBaker ^. BaseAccounts.poolMetadataUrl == metadataUrl
+            then return (bsp, pu)
+            else return (bsp, pu{updMetadataURL = Just metadataUrl})
+    updateTransactionFeeCommission oldBaker =
+        ifPresent vuTransactionFeeCommission $ \tfc (bsp, pu) -> do
+            MTL.tell [BakerConfigureTransactionFeeCommission tfc]
+            if oldBaker ^. BaseAccounts.poolCommissionRates . transactionCommission == tfc
+                then return (bsp, pu)
+                else return (bsp, pu{updTransactionFeeCommission = Just tfc})
+    updateBakingRewardCommission oldBaker =
+        ifPresent vuBakingRewardCommission $ \brc (bsp, pu) -> do
+            MTL.tell [BakerConfigureBakingRewardCommission brc]
+            if oldBaker ^. BaseAccounts.poolCommissionRates . bakingCommission == brc
+                then return (bsp, pu)
+                else return (bsp, pu{updBakingRewardCommission = Just brc})
+    updateFinalizationRewardCommission oldBaker =
+        ifPresent vuFinalizationRewardCommission $ \frc (bsp, pu) -> do
+            MTL.tell [BakerConfigureFinalizationRewardCommission frc]
+            if oldBaker ^. BaseAccounts.poolCommissionRates . finalizationCommission == frc
+                then return (bsp, pu)
+                else return (bsp, pu{updFinalizationRewardCommission = Just frc})
+    updateCapital = updateCapital' (sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv)))
+    updateCapital' SFalse oldBaker = ifPresent vuCapital $ \capital (bsp, acc) -> do
+        cp <- lookupCurrentParameters (bspUpdates bsp)
+        let cooldownDuration = cp ^. cpCooldownParameters . cpPoolOwnerCooldown
+            cooldownElapsed =
+                BaseAccounts.PendingChangeEffectiveV1 $
+                    addDurationSeconds curTimestamp cooldownDuration
+        let oldCapital = oldBaker ^. BaseAccounts.stakedAmount
+        if capital == 0
+            then do
+                -- Validator is being removed. (Removal occurs after cooldown.)
+                MTL.tell [BakerConfigureStakeReduced capital]
+                let bpc = BaseAccounts.RemoveStake cooldownElapsed
+                (bsp,) <$> setAccountStakePendingChange bpc acc
+            else case compare capital oldCapital of
+                LT -> do
+                    -- Stake reduced.
+                    MTL.tell [BakerConfigureStakeReduced capital]
+                    let bpc = BaseAccounts.ReduceStake capital cooldownElapsed
+                    (bsp,) <$> setAccountStakePendingChange bpc acc
+                EQ -> do
+                    -- Stake unchanged: record as if increased.
+                    MTL.tell [BakerConfigureStakeIncreased capital]
+                    return (bsp, acc)
+                GT -> do
+                    -- Stake increased
+                    MTL.tell [BakerConfigureStakeIncreased capital]
+                    bsp1 <-
+                        modifyActiveCapital
+                            (addActiveCapital $ capital - oldCapital)
+                            bsp
+                    acc1 <- setAccountStake capital acc
+                    return (bsp1, acc1)
+    updateCapital' STrue oldBaker = ifPresent vuCapital $ \capital (bsp, acc) -> do
+        let oldCapital = oldBaker ^. BaseAccounts.stakedAmount
+        if capital == 0
+            then do
+                MTL.tell [BakerConfigureStakeReduced 0]
+                alreadyInPrePreCooldown <- accountHasPrePreCooldown acc
+                acc1 <-
+                    removeAccountStake acc
+                        >>= addAccountPrePreCooldown oldCapital
+                bsp1 <- moveDelegatorsToPassive bsp (Just oldCapital)
+                bsp2 <- (if alreadyInPrePreCooldown then return else addToPrePreCooldowns) bsp1
+                return (bsp2, acc1)
+            else case compare capital oldCapital of
+                LT -> do
+                    MTL.tell [BakerConfigureStakeReduced capital]
+                    alreadyInPrePreCooldown <- accountHasPrePreCooldown acc
+                    acc1 <-
+                        setAccountStake capital acc
+                            >>= addAccountPrePreCooldown (oldCapital - capital)
+                    bsp1 <- modifyActiveCapital (subtractActiveCapital $ oldCapital - capital) bsp
+                    bsp2 <- (if alreadyInPrePreCooldown then return else addToPrePreCooldowns) bsp1
+                    return (bsp2, acc1)
+                EQ -> do
+                    MTL.tell [BakerConfigureStakeIncreased capital]
+                    return (bsp, acc)
+                GT -> do
+                    MTL.tell [BakerConfigureStakeIncreased capital]
+                    oldCooldowns <- accountCooldowns acc
+                    acc1 <-
+                        setAccountStake capital acc
+                            >>= reactivateCooldownAmount (capital - oldCapital)
+                    newCooldowns <- accountCooldowns acc1
+                    let removals = cooldownRemovals oldCooldowns newCooldowns
+                    bsp1 <- modifyActiveCapital (addActiveCapital $ capital - oldCapital) bsp
+                    newAIC <- applyCooldownRemovalsGlobally ai removals (bspAccountsInCooldown bsp1)
+                    let bsp2 = bsp1{bspAccountsInCooldown = newAIC}
+                    return (bsp2, acc1)
+    -- Move all @bid@'s current delegators into passive delegation.
+    -- If the amount (the baker's prior stake) is specified, then @bid@ is removed from the active
+    -- bakers, and the total active capital is reduced accordingly.
+    moveDelegatorsToPassive bsp mAmount = do
+        pab0 <- refLoad (bspBirkParameters bsp ^. birkActiveBakers)
+        (delegators, pab1) <- transferDelegatorsToPassive bid pab0
+        pab2 <- case mAmount of
+            Nothing -> return pab1
+            Just amount -> do
+                newTrie <- Trie.delete bid (pab1 ^. activeBakers)
+                return $ pab1 & totalActiveCapital %~ subtractActiveCapital amount & activeBakers .~ newTrie
+        newPABref <- refMake pab2
+        let newBirkParams = bspBirkParameters bsp & birkActiveBakers .~ newPABref
+        newAccounts <- foldM redelegatePassive (bspAccounts bsp) delegators
+        return bsp{bspBirkParameters = newBirkParams, bspAccounts = newAccounts}
+    modifyActiveCapital upd bsp = do
+        pab <- refLoad (bspBirkParameters bsp ^. birkActiveBakers)
+        newPABref <- refMake $ pab & totalActiveCapital %~ upd
+        return bsp{bspBirkParameters = bspBirkParameters bsp & birkActiveBakers .~ newPABref}
+    addToPrePreCooldowns ::
+        (MonadBlobStore m', PVSupportsFlexibleCooldown pv) =>
+        BlockStatePointers pv ->
+        m' (BlockStatePointers pv)
+    addToPrePreCooldowns bsp = do
+        newAccountsInCooldown <-
+            (accountsInCooldown . prePreCooldown)
+                (consAccountList ai)
+                (bspAccountsInCooldown bsp)
+        return bsp{bspAccountsInCooldown = newAccountsInCooldown}
+
 doConfigureBaker ::
     forall pv m.
     ( SupportsPersistentState pv m,
@@ -1710,65 +1962,65 @@ doConfigureBaker pbs ai BakerConfigureAdd{..} = do
             let capitalMin = poolParams ^. ppMinimumEquityCapital
             let ranges = poolParams ^. ppCommissionBounds
             if
-                | bcaCapital < capitalMin -> return (BCStakeUnderThreshold, pbs)
-                | not (isInRange bcaTransactionFeeCommission (ranges ^. transactionCommissionRange)) ->
-                    return (BCTransactionFeeCommissionNotInRange, pbs)
-                | not (isInRange bcaBakingRewardCommission (ranges ^. bakingCommissionRange)) ->
-                    return (BCBakingRewardCommissionNotInRange, pbs)
-                | not (isInRange bcaFinalizationRewardCommission (ranges ^. finalizationCommissionRange)) ->
-                    return (BCFinalizationRewardCommissionNotInRange, pbs)
-                | otherwise -> do
-                    let bid = BakerId ai
-                    oldPAB <- refLoad (_birkActiveBakers (bspBirkParameters bsp))
-                    maybeDel <- accountDelegator acc
-                    pab <- maybeRemoveDelegator (sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv))) maybeDel oldPAB
-                    let updAgg Nothing = return (True, Trie.Insert ())
-                        updAgg (Just ()) = return (False, Trie.NoChange)
-                    Trie.adjust updAgg (bkuAggregationKey bcaKeys) (_aggregationKeys pab) >>= \case
-                        -- Aggregation key is a duplicate
-                        (False, _) -> return (BCDuplicateAggregationKey (bkuAggregationKey bcaKeys), pbs)
-                        (True, newAggregationKeys) -> do
-                            newActiveBakers <- Trie.insert bid emptyPersistentActiveDelegators (_activeBakers pab)
-                            newpabref <-
-                                refMake
-                                    PersistentActiveBakers
-                                        { _aggregationKeys = newAggregationKeys,
-                                          _activeBakers = newActiveBakers,
-                                          _passiveDelegators = pab ^. passiveDelegators,
-                                          _totalActiveCapital = addActiveCapital bcaCapital (_totalActiveCapital pab)
-                                        }
-                            let newBirkParams = bspBirkParameters bsp & birkActiveBakers .~ newpabref
-                            let cr =
-                                    CommissionRates
-                                        { _finalizationCommission = bcaFinalizationRewardCommission,
-                                          _bakingCommission = bcaBakingRewardCommission,
-                                          _transactionCommission = bcaTransactionFeeCommission
-                                        }
-                                poolInfo =
-                                    BaseAccounts.BakerPoolInfo
-                                        { _poolOpenStatus = bcaOpenForDelegation,
-                                          _poolMetadataUrl = bcaMetadataURL,
-                                          _poolCommissionRates = cr
-                                        }
-                                bakerInfo = bakerKeyUpdateToInfo bid bcaKeys
-                                bakerInfoEx =
-                                    BaseAccounts.BakerInfoExV1
-                                        { _bieBakerPoolInfo = poolInfo,
-                                          _bieBakerInfo = bakerInfo
-                                        }
-                                updAcc = addAccountBakerV1 bakerInfoEx bcaCapital bcaRestakeEarnings
-                            newBSP <-
-                                updateAccountsAndMaybeCooldown
-                                    (sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv)))
-                                    acc
-                                    maybeDel
-                                    updAcc
-                                    bcaCapital
-                                    bsp{bspBirkParameters = newBirkParams}
-                            (BCSuccess [] bid,)
-                                <$> storePBS
-                                    pbs
-                                    newBSP
+                    | bcaCapital < capitalMin -> return (BCStakeUnderThreshold, pbs)
+                    | not (isInRange bcaTransactionFeeCommission (ranges ^. transactionCommissionRange)) ->
+                        return (BCTransactionFeeCommissionNotInRange, pbs)
+                    | not (isInRange bcaBakingRewardCommission (ranges ^. bakingCommissionRange)) ->
+                        return (BCBakingRewardCommissionNotInRange, pbs)
+                    | not (isInRange bcaFinalizationRewardCommission (ranges ^. finalizationCommissionRange)) ->
+                        return (BCFinalizationRewardCommissionNotInRange, pbs)
+                    | otherwise -> do
+                        let bid = BakerId ai
+                        oldPAB <- refLoad (_birkActiveBakers (bspBirkParameters bsp))
+                        maybeDel <- accountDelegator acc
+                        pab <- maybeRemoveDelegator (sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv))) maybeDel oldPAB
+                        let updAgg Nothing = return (True, Trie.Insert ())
+                            updAgg (Just ()) = return (False, Trie.NoChange)
+                        Trie.adjust updAgg (bkuAggregationKey bcaKeys) (_aggregationKeys pab) >>= \case
+                            -- Aggregation key is a duplicate
+                            (False, _) -> return (BCDuplicateAggregationKey (bkuAggregationKey bcaKeys), pbs)
+                            (True, newAggregationKeys) -> do
+                                newActiveBakers <- Trie.insert bid emptyPersistentActiveDelegators (_activeBakers pab)
+                                newpabref <-
+                                    refMake
+                                        PersistentActiveBakers
+                                            { _aggregationKeys = newAggregationKeys,
+                                              _activeBakers = newActiveBakers,
+                                              _passiveDelegators = pab ^. passiveDelegators,
+                                              _totalActiveCapital = addActiveCapital bcaCapital (_totalActiveCapital pab)
+                                            }
+                                let newBirkParams = bspBirkParameters bsp & birkActiveBakers .~ newpabref
+                                let cr =
+                                        CommissionRates
+                                            { _finalizationCommission = bcaFinalizationRewardCommission,
+                                              _bakingCommission = bcaBakingRewardCommission,
+                                              _transactionCommission = bcaTransactionFeeCommission
+                                            }
+                                    poolInfo =
+                                        BaseAccounts.BakerPoolInfo
+                                            { _poolOpenStatus = bcaOpenForDelegation,
+                                              _poolMetadataUrl = bcaMetadataURL,
+                                              _poolCommissionRates = cr
+                                            }
+                                    bakerInfo = bakerKeyUpdateToInfo bid bcaKeys
+                                    bakerInfoEx =
+                                        BaseAccounts.BakerInfoExV1
+                                            { _bieBakerPoolInfo = poolInfo,
+                                              _bieBakerInfo = bakerInfo
+                                            }
+                                    updAcc = addAccountBakerV1 bakerInfoEx bcaCapital bcaRestakeEarnings
+                                newBSP <-
+                                    updateAccountsAndMaybeCooldown
+                                        (sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv)))
+                                        acc
+                                        maybeDel
+                                        updAcc
+                                        bcaCapital
+                                        bsp{bspBirkParameters = newBirkParams}
+                                (BCSuccess [] bid,)
+                                    <$> storePBS
+                                        pbs
+                                        newBSP
   where
     maybeRemoveDelegator ::
         SBool (SupportsFlexibleCooldown (AccountVersionFor pv)) ->
@@ -2901,8 +3153,8 @@ doMint pbs mint = do
             bspBank bsp
                 & unhashed
                     %~ (Rewards.totalGTU +~ mintTotal mint)
-                        . (Rewards.bakingRewardAccount +~ mintBakingReward mint)
-                        . (Rewards.finalizationRewardAccount +~ mintFinalizationReward mint)
+                    . (Rewards.bakingRewardAccount +~ mintBakingReward mint)
+                    . (Rewards.finalizationRewardAccount +~ mintFinalizationReward mint)
     let updAcc = addAccountAmount $ mintDevelopmentCharge mint
     foundationAccount <- (^. cpFoundationAccount) <$> lookupCurrentParameters (bspUpdates bsp)
     newAccounts <- Accounts.updateAccountsAtIndex' updAcc foundationAccount (bspAccounts bsp)

From dc1407ee6bae7c4c28831420cf607c31c1bb48e7 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Mon, 22 Jul 2024 10:33:59 +0200
Subject: [PATCH 33/81] Delegation

---
 .../src/Concordium/GlobalState/BakerInfo.hs   |  25 +++-
 .../GlobalState/Persistent/BlockState.hs      | 113 ++++++++++++++++++
 2 files changed, 137 insertions(+), 1 deletion(-)

diff --git a/concordium-consensus/src/Concordium/GlobalState/BakerInfo.hs b/concordium-consensus/src/Concordium/GlobalState/BakerInfo.hs
index d3a180bb6..7cf099a6a 100644
--- a/concordium-consensus/src/Concordium/GlobalState/BakerInfo.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/BakerInfo.hs
@@ -196,7 +196,7 @@ data ValidatorAdd = ValidatorAdd
 data ValidatorUpdate = ValidatorUpdate
     { -- | The new keys for the validator.
       vuKeys :: !(Maybe BakerKeyUpdate),
-      -- | The new capital for the validator.
+      -- | The new capital for the validator. If this is @Just 0@, the validator is removed.
       vuCapital :: !(Maybe Amount),
       -- | Whether to restake earned rewards.
       vuRestakeEarnings :: !(Maybe Bool),
@@ -287,6 +287,29 @@ data BakerRemoveResult
       BRChangePending !BakerId
     deriving (Eq, Ord, Show)
 
+-- | Parameters for adding a delegator.
+data DelegatorAdd = DelegatorAdd
+    { -- | The initial staked capital for the delegator.
+      daCapital :: !Amount,
+      -- | Whether to restake earnings.
+      daRestakeEarnings :: !Bool,
+      -- | The delegation target for the delegator.
+      daDelegationTarget :: !DelegationTarget
+    }
+    deriving (Eq, Show)
+
+-- | Parameters for updating an existing delegator. Where a field is 'Nothing', the field is not
+--  updated.
+data DelegatorUpdate = DelegatorUpdate
+    { -- | The new capital for the delegator. If this is @Just 0@, the delegator is removed.
+      duCapital :: !(Maybe Amount),
+      -- | Whether to restake earnings.
+      duRestakeEarnings :: !(Maybe Bool),
+      -- | The new delegation target for the delegator.
+      duDelegationTarget :: !(Maybe DelegationTarget)
+    }
+    deriving (Eq, Show)
+
 -- | Data structure used to add/remove/update delegator.
 data DelegationConfigure
     = -- | Add a delegator, all fields are required.
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
index 53d2e863c..1abc6c98a 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
@@ -2492,6 +2492,119 @@ delegationCheckTargetOpen bsp (Transactions.DelegateToBaker bid@(BakerId baid))
                 _ -> MTL.throwError DCPoolClosed
         _ -> MTL.throwError (DCInvalidDelegationTarget bid)
 
+data DelegatorConfigureFailure
+    = DCFInvalidDelegationTarget !BakerId
+    | DCFPoolClosed
+    | DCFPoolStakeOverThreshold
+    | DCFPoolOverDelegated
+
+addDelegatorChecks ::
+    ( IsProtocolVersion pv,
+      PVSupportsDelegation pv,
+      MTL.MonadError DelegatorConfigureFailure m,
+      SupportsPersistentAccount pv m,
+      PoolParametersVersionFor (ChainParametersVersionFor pv) ~ 'PoolParametersVersion1
+    ) =>
+    BlockStatePointers pv ->
+    DelegatorAdd ->
+    m ()
+addDelegatorChecks _ DelegatorAdd{daDelegationTarget = Transactions.DelegatePassive} = return ()
+addDelegatorChecks bsp DelegatorAdd{daDelegationTarget = Transactions.DelegateToBaker bid, ..} = do
+    onAccount baid bsp accountBaker >>= \case
+        Just baker -> do
+            unless (baker ^. BaseAccounts.poolOpenStatus == Transactions.OpenForAll) $
+                MTL.throwError DCFPoolClosed
+            poolParams <- _cpPoolParameters <$> lookupCurrentParameters (bspUpdates bsp)
+            let bakerEquityCapital = baker ^. BaseAccounts.stakedAmount
+            bakerDelegatedCapital <- (daCapital +) <$> poolDelegatorCapital bsp bid
+            capitalTotal <- (daCapital +) <$> totalCapital bsp
+            let PoolCaps{..} = delegatedCapitalCaps poolParams capitalTotal bakerEquityCapital bakerDelegatedCapital
+            when (bakerDelegatedCapital > leverageCap) $ MTL.throwError DCFPoolStakeOverThreshold
+            when (bakerDelegatedCapital > boundCap) $ MTL.throwError DCFPoolOverDelegated
+        Nothing -> MTL.throwError (DCFInvalidDelegationTarget bid)
+  where
+    BakerId baid = bid
+
+newAddDelegator ::
+    forall pv m.
+    ( SupportsPersistentState pv m,
+      PVSupportsDelegation pv,
+      IsSupported 'PTTimeParameters (ChainParametersVersionFor pv) ~ 'True,
+      PoolParametersVersionFor (ChainParametersVersionFor pv) ~ 'PoolParametersVersion1,
+      CooldownParametersVersionFor (ChainParametersVersionFor pv) ~ 'CooldownParametersVersion1
+    ) =>
+    PersistentBlockState (MPV m) ->
+    AccountIndex ->
+    DelegatorAdd ->
+    MTL.ExceptT DelegatorConfigureFailure m (PersistentBlockState (MPV m))
+newAddDelegator pbs ai da@DelegatorAdd{..} = do
+    bsp <- loadPBS pbs
+    addDelegatorChecks bsp da
+    pab <- refLoad $ bspBirkParameters bsp ^. birkActiveBakers
+    newActiveBakers <- case daDelegationTarget of
+        Transactions.DelegatePassive -> do
+
+updateDelegatorChecks ::
+    forall pv m.
+    ( IsProtocolVersion pv,
+      PVSupportsDelegation pv,
+      MTL.MonadError DelegationConfigureResult m,
+      SupportsPersistentAccount pv m,
+      ChainParametersVersionFor pv ~ 'ChainParametersV1
+    ) =>
+    BlockStatePointers pv ->
+    PersistentAccount (AccountVersionFor pv) ->
+    DelegatorUpdate ->
+    m ()
+updateDelegatorChecks bsp acc DelegatorUpdate{..} = do
+    -- Cannot fail: the account must already be a delegator.
+    oldDelegator <- fromJust <$> accountDelegator acc
+    let oldStake = oldDelegator ^. BaseAccounts.delegationStakedAmount
+    let newEffectiveStake = case duCapital of
+            Nothing -> oldStake
+            Just newStake -> case flexibleCooldown of
+                SFalse | newStake <= oldStake -> oldStake
+                _ -> newStake
+    let delta = newEffectiveStake `amountDiff` oldStake
+    let checkChangePending
+            | isJust duCapital,
+              oldDelegator ^. BaseAccounts.delegationPendingChange /= BaseAccounts.NoChange =
+                MTL.throwError DCChangePending
+            | otherwise = return ()
+    case duDelegationTarget of
+        Nothing -> do
+            checkChangePending
+            case oldDelegator ^. BaseAccounts.delegationTarget of
+                Transactions.DelegatePassive -> return ()
+                Transactions.DelegateToBaker bid@(BakerId baid) -> do
+                    -- Cannot fail: the account must delegate to a valid baker.
+                    baker <- fromJust <$> onAccount baid bsp accountBaker
+                    checkBounds bid baker delta delta
+        Just Transactions.DelegatePassive -> do
+            checkChangePending
+        Just (Transactions.DelegateToBaker bid@(BakerId baid)) ->
+            onAccount baid bsp accountBaker >>= \case
+                Just baker -> do
+                    unless (baker ^. BaseAccounts.poolOpenStatus == Transactions.OpenForAll) $
+                        MTL.throwError DCPoolClosed
+                    checkChangePending
+                    let sameBaker =
+                            Transactions.DelegateToBaker bid
+                                == oldDelegator ^. BaseAccounts.delegationTarget
+                    let poolDelta = if sameBaker then delta else amountToDelta newEffectiveStake
+                    checkBounds bid baker delta poolDelta
+                Nothing -> MTL.throwError (DCInvalidDelegationTarget bid)
+  where
+    flexibleCooldown = sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv))
+    checkBounds bid baker delta poolDelta = do
+        poolParams <- _cpPoolParameters <$> lookupCurrentParameters (bspUpdates bsp)
+        let bakerEquityCapital = baker ^. BaseAccounts.stakedAmount
+        bakerDelegatedCapital <- applyAmountDelta poolDelta <$> poolDelegatorCapital bsp bid
+        capitalTotal <- applyAmountDelta delta <$> totalCapital bsp
+        let PoolCaps{..} = delegatedCapitalCaps poolParams capitalTotal bakerEquityCapital bakerDelegatedCapital
+        when (bakerDelegatedCapital > leverageCap) $ MTL.throwError DCPoolStakeOverThreshold
+        when (bakerDelegatedCapital > boundCap) $ MTL.throwError DCPoolOverDelegated
+
 doConfigureDelegation ::
     forall pv m.
     ( SupportsPersistentState pv m,

From 6ad3320e8366f0dddb41f806d6ce8c292f09e207 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Mon, 22 Jul 2024 13:00:34 +0200
Subject: [PATCH 34/81] Add delegator.

---
 .../GlobalState/Persistent/Bakers.hs          |  18 ++
 .../GlobalState/Persistent/BlockState.hs      | 244 +++++++++++-------
 2 files changed, 165 insertions(+), 97 deletions(-)

diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Bakers.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Bakers.hs
index 1bebe55cd..5e39e85e7 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Bakers.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Bakers.hs
@@ -463,6 +463,24 @@ addDelegator (DelegateToBaker bid) did amt pab =
             newActiveBakers <- Trie.insert bid pad' (pab ^. activeBakers)
             return $ Right $ pab & activeBakers .~ newActiveBakers
 
+-- | Add a delegator to the persistent active bakers at a particular target.
+--  It is assumed that the delegator is not already delegated to this target.
+--  If the target is a baker, then the baker MUST be in the active bakers.
+--
+--  IMPORTANT: This does not update the total active capital!
+addDelegatorUnsafe ::
+    (MonadBlobStore m, IsAccountVersion av, AVSupportsDelegation av) =>
+    DelegationTarget ->
+    DelegatorId ->
+    Amount ->
+    PersistentActiveBakers av ->
+    m (PersistentActiveBakers av)
+addDelegatorUnsafe dt did amt pab = do
+    res <- addDelegator dt did amt pab
+    case res of
+        Left bid -> error $ "addDelegatorUnsafe: Invalid baker id: " ++ show bid
+        Right pab' -> return pab'
+
 -- | A helper function that removes a delegator from a 'PersistentActiveDelegators'.
 --  It is assumed that the delegator is in the delegators with the specified amount.
 removeDelegatorHelper ::
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
index 1abc6c98a..f5f056c35 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
@@ -1962,65 +1962,65 @@ doConfigureBaker pbs ai BakerConfigureAdd{..} = do
             let capitalMin = poolParams ^. ppMinimumEquityCapital
             let ranges = poolParams ^. ppCommissionBounds
             if
-                    | bcaCapital < capitalMin -> return (BCStakeUnderThreshold, pbs)
-                    | not (isInRange bcaTransactionFeeCommission (ranges ^. transactionCommissionRange)) ->
-                        return (BCTransactionFeeCommissionNotInRange, pbs)
-                    | not (isInRange bcaBakingRewardCommission (ranges ^. bakingCommissionRange)) ->
-                        return (BCBakingRewardCommissionNotInRange, pbs)
-                    | not (isInRange bcaFinalizationRewardCommission (ranges ^. finalizationCommissionRange)) ->
-                        return (BCFinalizationRewardCommissionNotInRange, pbs)
-                    | otherwise -> do
-                        let bid = BakerId ai
-                        oldPAB <- refLoad (_birkActiveBakers (bspBirkParameters bsp))
-                        maybeDel <- accountDelegator acc
-                        pab <- maybeRemoveDelegator (sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv))) maybeDel oldPAB
-                        let updAgg Nothing = return (True, Trie.Insert ())
-                            updAgg (Just ()) = return (False, Trie.NoChange)
-                        Trie.adjust updAgg (bkuAggregationKey bcaKeys) (_aggregationKeys pab) >>= \case
-                            -- Aggregation key is a duplicate
-                            (False, _) -> return (BCDuplicateAggregationKey (bkuAggregationKey bcaKeys), pbs)
-                            (True, newAggregationKeys) -> do
-                                newActiveBakers <- Trie.insert bid emptyPersistentActiveDelegators (_activeBakers pab)
-                                newpabref <-
-                                    refMake
-                                        PersistentActiveBakers
-                                            { _aggregationKeys = newAggregationKeys,
-                                              _activeBakers = newActiveBakers,
-                                              _passiveDelegators = pab ^. passiveDelegators,
-                                              _totalActiveCapital = addActiveCapital bcaCapital (_totalActiveCapital pab)
-                                            }
-                                let newBirkParams = bspBirkParameters bsp & birkActiveBakers .~ newpabref
-                                let cr =
-                                        CommissionRates
-                                            { _finalizationCommission = bcaFinalizationRewardCommission,
-                                              _bakingCommission = bcaBakingRewardCommission,
-                                              _transactionCommission = bcaTransactionFeeCommission
-                                            }
-                                    poolInfo =
-                                        BaseAccounts.BakerPoolInfo
-                                            { _poolOpenStatus = bcaOpenForDelegation,
-                                              _poolMetadataUrl = bcaMetadataURL,
-                                              _poolCommissionRates = cr
-                                            }
-                                    bakerInfo = bakerKeyUpdateToInfo bid bcaKeys
-                                    bakerInfoEx =
-                                        BaseAccounts.BakerInfoExV1
-                                            { _bieBakerPoolInfo = poolInfo,
-                                              _bieBakerInfo = bakerInfo
-                                            }
-                                    updAcc = addAccountBakerV1 bakerInfoEx bcaCapital bcaRestakeEarnings
-                                newBSP <-
-                                    updateAccountsAndMaybeCooldown
-                                        (sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv)))
-                                        acc
-                                        maybeDel
-                                        updAcc
-                                        bcaCapital
-                                        bsp{bspBirkParameters = newBirkParams}
-                                (BCSuccess [] bid,)
-                                    <$> storePBS
-                                        pbs
-                                        newBSP
+                | bcaCapital < capitalMin -> return (BCStakeUnderThreshold, pbs)
+                | not (isInRange bcaTransactionFeeCommission (ranges ^. transactionCommissionRange)) ->
+                    return (BCTransactionFeeCommissionNotInRange, pbs)
+                | not (isInRange bcaBakingRewardCommission (ranges ^. bakingCommissionRange)) ->
+                    return (BCBakingRewardCommissionNotInRange, pbs)
+                | not (isInRange bcaFinalizationRewardCommission (ranges ^. finalizationCommissionRange)) ->
+                    return (BCFinalizationRewardCommissionNotInRange, pbs)
+                | otherwise -> do
+                    let bid = BakerId ai
+                    oldPAB <- refLoad (_birkActiveBakers (bspBirkParameters bsp))
+                    maybeDel <- accountDelegator acc
+                    pab <- maybeRemoveDelegator (sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv))) maybeDel oldPAB
+                    let updAgg Nothing = return (True, Trie.Insert ())
+                        updAgg (Just ()) = return (False, Trie.NoChange)
+                    Trie.adjust updAgg (bkuAggregationKey bcaKeys) (_aggregationKeys pab) >>= \case
+                        -- Aggregation key is a duplicate
+                        (False, _) -> return (BCDuplicateAggregationKey (bkuAggregationKey bcaKeys), pbs)
+                        (True, newAggregationKeys) -> do
+                            newActiveBakers <- Trie.insert bid emptyPersistentActiveDelegators (_activeBakers pab)
+                            newpabref <-
+                                refMake
+                                    PersistentActiveBakers
+                                        { _aggregationKeys = newAggregationKeys,
+                                          _activeBakers = newActiveBakers,
+                                          _passiveDelegators = pab ^. passiveDelegators,
+                                          _totalActiveCapital = addActiveCapital bcaCapital (_totalActiveCapital pab)
+                                        }
+                            let newBirkParams = bspBirkParameters bsp & birkActiveBakers .~ newpabref
+                            let cr =
+                                    CommissionRates
+                                        { _finalizationCommission = bcaFinalizationRewardCommission,
+                                          _bakingCommission = bcaBakingRewardCommission,
+                                          _transactionCommission = bcaTransactionFeeCommission
+                                        }
+                                poolInfo =
+                                    BaseAccounts.BakerPoolInfo
+                                        { _poolOpenStatus = bcaOpenForDelegation,
+                                          _poolMetadataUrl = bcaMetadataURL,
+                                          _poolCommissionRates = cr
+                                        }
+                                bakerInfo = bakerKeyUpdateToInfo bid bcaKeys
+                                bakerInfoEx =
+                                    BaseAccounts.BakerInfoExV1
+                                        { _bieBakerPoolInfo = poolInfo,
+                                          _bieBakerInfo = bakerInfo
+                                        }
+                                updAcc = addAccountBakerV1 bakerInfoEx bcaCapital bcaRestakeEarnings
+                            newBSP <-
+                                updateAccountsAndMaybeCooldown
+                                    (sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv)))
+                                    acc
+                                    maybeDel
+                                    updAcc
+                                    bcaCapital
+                                    bsp{bspBirkParameters = newBirkParams}
+                            (BCSuccess [] bid,)
+                                <$> storePBS
+                                    pbs
+                                    newBSP
   where
     maybeRemoveDelegator ::
         SBool (SupportsFlexibleCooldown (AccountVersionFor pv)) ->
@@ -2511,6 +2511,7 @@ addDelegatorChecks ::
 addDelegatorChecks _ DelegatorAdd{daDelegationTarget = Transactions.DelegatePassive} = return ()
 addDelegatorChecks bsp DelegatorAdd{daDelegationTarget = Transactions.DelegateToBaker bid, ..} = do
     onAccount baid bsp accountBaker >>= \case
+        Nothing -> MTL.throwError (DCFInvalidDelegationTarget bid)
         Just baker -> do
             unless (baker ^. BaseAccounts.poolOpenStatus == Transactions.OpenForAll) $
                 MTL.throwError DCFPoolClosed
@@ -2521,7 +2522,6 @@ addDelegatorChecks bsp DelegatorAdd{daDelegationTarget = Transactions.DelegateTo
             let PoolCaps{..} = delegatedCapitalCaps poolParams capitalTotal bakerEquityCapital bakerDelegatedCapital
             when (bakerDelegatedCapital > leverageCap) $ MTL.throwError DCFPoolStakeOverThreshold
             when (bakerDelegatedCapital > boundCap) $ MTL.throwError DCFPoolOverDelegated
-        Nothing -> MTL.throwError (DCFInvalidDelegationTarget bid)
   where
     BakerId baid = bid
 
@@ -2540,9 +2540,52 @@ newAddDelegator ::
 newAddDelegator pbs ai da@DelegatorAdd{..} = do
     bsp <- loadPBS pbs
     addDelegatorChecks bsp da
-    pab <- refLoad $ bspBirkParameters bsp ^. birkActiveBakers
-    newActiveBakers <- case daDelegationTarget of
-        Transactions.DelegatePassive -> do
+    newBirkParameters <- do
+        pab <- refLoad $ bspBirkParameters bsp ^. birkActiveBakers
+        -- Cannot fail: the delegation target is valid.
+        newActiveBakers <-
+            addDelegatorUnsafe daDelegationTarget did daCapital pab
+                <&> totalActiveCapital %~ addActiveCapital daCapital
+        newPABRef <- refMake newActiveBakers
+        return $ bspBirkParameters bsp & birkActiveBakers .~ newPABRef
+    case flexibleCooldown of
+        SFalse -> do
+            newAccounts <-
+                Accounts.updateAccountsAtIndex'
+                    (addAccountDelegator newDelegator)
+                    ai
+                    (bspAccounts bsp)
+            storePBS pbs $
+                bsp
+                    { bspAccounts = newAccounts,
+                      bspBirkParameters = newBirkParameters
+                    }
+        STrue -> do
+            acc <- fromJust <$> Accounts.indexedAccount ai (bspAccounts bsp)
+            maybeCooldownsBefore <- accountCooldowns acc
+            newAcc <- (addAccountDelegator newDelegator >=> reactivateCooldownAmount daCapital) acc
+            maybeCooldownsAfter <- accountCooldowns newAcc
+            let removals = cooldownRemovals maybeCooldownsBefore maybeCooldownsAfter
+            newCooldowns <- applyCooldownRemovalsGlobally ai removals (bspAccountsInCooldown bsp)
+            newAccounts <- Accounts.setAccountAtIndex ai newAcc (bspAccounts bsp)
+            storePBS pbs $
+                bsp
+                    { bspAccounts = newAccounts,
+                      bspBirkParameters = newBirkParameters,
+                      bspAccountsInCooldown = newCooldowns
+                    }
+  where
+    did = DelegatorId ai
+    flexibleCooldown = sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv))
+    newDelegator :: BaseAccounts.AccountDelegation (AccountVersionFor pv)
+    newDelegator =
+        BaseAccounts.AccountDelegationV1
+            { _delegationTarget = daDelegationTarget,
+              _delegationStakedAmount = daCapital,
+              _delegationStakeEarnings = daRestakeEarnings,
+              _delegationPendingChange = BaseAccounts.NoChange,
+              _delegationIdentity = did
+            }
 
 updateDelegatorChecks ::
     forall pv m.
@@ -2559,51 +2602,58 @@ updateDelegatorChecks ::
 updateDelegatorChecks bsp acc DelegatorUpdate{..} = do
     -- Cannot fail: the account must already be a delegator.
     oldDelegator <- fromJust <$> accountDelegator acc
-    let oldStake = oldDelegator ^. BaseAccounts.delegationStakedAmount
-    let newEffectiveStake = case duCapital of
-            Nothing -> oldStake
-            Just newStake -> case flexibleCooldown of
-                SFalse | newStake <= oldStake -> oldStake
-                _ -> newStake
-    let delta = newEffectiveStake `amountDiff` oldStake
-    let checkChangePending
-            | isJust duCapital,
-              oldDelegator ^. BaseAccounts.delegationPendingChange /= BaseAccounts.NoChange =
-                MTL.throwError DCChangePending
-            | otherwise = return ()
-    case duDelegationTarget of
-        Nothing -> do
-            checkChangePending
-            case oldDelegator ^. BaseAccounts.delegationTarget of
-                Transactions.DelegatePassive -> return ()
-                Transactions.DelegateToBaker bid@(BakerId baid) -> do
-                    -- Cannot fail: the account must delegate to a valid baker.
-                    baker <- fromJust <$> onAccount baid bsp accountBaker
-                    checkBounds bid baker delta delta
-        Just Transactions.DelegatePassive -> do
-            checkChangePending
-        Just (Transactions.DelegateToBaker bid@(BakerId baid)) ->
+    -- Check that the delegation target is valid and open.
+    (mTargetBaker) <- case duDelegationTarget of
+        Nothing -> case oldDelegator ^. BaseAccounts.delegationTarget of
+            Transactions.DelegatePassive -> return Nothing
+            Transactions.DelegateToBaker bid -> do
+                -- Cannot fail: the account must delegate to a valid baker.
+                baker <- fromJust <$> onAccount baid bps accountBaker
+                -- Since it wasn't changed, the baker is the same as before.
+                return (Just (baker, True))
+        Just Transactions.DelegatePassive -> return Nothing
+        Just (Transactions.DelegateToBaker bid) -> do
             onAccount baid bsp accountBaker >>= \case
+                Nothing -> MTL.throwError (DCInvalidDelegationTarget bid)
                 Just baker -> do
                     unless (baker ^. BaseAccounts.poolOpenStatus == Transactions.OpenForAll) $
                         MTL.throwError DCPoolClosed
-                    checkChangePending
                     let sameBaker =
                             Transactions.DelegateToBaker bid
                                 == oldDelegator ^. BaseAccounts.delegationTarget
-                    let poolDelta = if sameBaker then delta else amountToDelta newEffectiveStake
-                    checkBounds bid baker delta poolDelta
-                Nothing -> MTL.throwError (DCInvalidDelegationTarget bid)
-  where
-    flexibleCooldown = sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv))
-    checkBounds bid baker delta poolDelta = do
+                    return $ Just (baker, sameBaker)
+    -- If the capital is being changed, check there is not a pending change.
+    let hasPendingChange =
+            oldDelegator ^. BaseAccounts.delegationPendingChange /= BaseAccounts.NoChange
+    when (isJust duCapital && hasPendingChange) $ MTL.throwError DCChangePending
+    -- If the target is a baker pool, check that the delegation amount is within bounds.
+    forM_ mTargetBaker $ \(baker, sameBaker) -> do
+        let oldStake = oldDelegator ^. BaseAccounts.delegationStakedAmount
+        -- The new effective stake is the old stake if:
+        --   - no new stake is provided, or
+        --   - the new stake is less than or equal to the old stake and the protocol version does
+        --     not support flexible cooldown. (In this case, the change will be pending on the
+        --     account.)
+        let newEffectiveStake = case duCapital of
+                Nothing -> oldStake
+                Just newStake -> case flexibleCooldown of
+                    SFalse | newStake <= oldStake -> oldStake
+                    _ -> newStake
+        -- The change to the total staked capital.
+        let delta = newEffectiveStake `amountDiff` oldStake
+        -- The change to the pool's staked capital. This depends on whether the delegator is
+        -- switching pools.
+        let poolDelta = if sameBaker then delta else amountToDelta newEffectiveStake
         poolParams <- _cpPoolParameters <$> lookupCurrentParameters (bspUpdates bsp)
         let bakerEquityCapital = baker ^. BaseAccounts.stakedAmount
         bakerDelegatedCapital <- applyAmountDelta poolDelta <$> poolDelegatorCapital bsp bid
         capitalTotal <- applyAmountDelta delta <$> totalCapital bsp
-        let PoolCaps{..} = delegatedCapitalCaps poolParams capitalTotal bakerEquityCapital bakerDelegatedCapital
+        let PoolCaps{..} =
+                delegatedCapitalCaps poolParams capitalTotal bakerEquityCapital bakerDelegatedCapital
         when (bakerDelegatedCapital > leverageCap) $ MTL.throwError DCPoolStakeOverThreshold
         when (bakerDelegatedCapital > boundCap) $ MTL.throwError DCPoolOverDelegated
+  where
+    flexibleCooldown = sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv))
 
 doConfigureDelegation ::
     forall pv m.
@@ -3266,8 +3316,8 @@ doMint pbs mint = do
             bspBank bsp
                 & unhashed
                     %~ (Rewards.totalGTU +~ mintTotal mint)
-                    . (Rewards.bakingRewardAccount +~ mintBakingReward mint)
-                    . (Rewards.finalizationRewardAccount +~ mintFinalizationReward mint)
+                        . (Rewards.bakingRewardAccount +~ mintBakingReward mint)
+                        . (Rewards.finalizationRewardAccount +~ mintFinalizationReward mint)
     let updAcc = addAccountAmount $ mintDevelopmentCharge mint
     foundationAccount <- (^. cpFoundationAccount) <$> lookupCurrentParameters (bspUpdates bsp)
     newAccounts <- Accounts.updateAccountsAtIndex' updAcc foundationAccount (bspAccounts bsp)

From 057d85a78967a8a4cae7f3ce061455d755585031 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Tue, 23 Jul 2024 17:24:43 +0200
Subject: [PATCH 35/81] Configure delegators.

---
 .../GlobalState/Persistent/Bakers.hs          |  31 +-
 .../GlobalState/Persistent/BlockState.hs      | 326 +++++++++++-------
 2 files changed, 232 insertions(+), 125 deletions(-)

diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Bakers.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Bakers.hs
index 5e39e85e7..24cc609a8 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Bakers.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Bakers.hs
@@ -279,6 +279,10 @@ data PersistentActiveDelegators (av :: AccountVersion) where
         } ->
         PersistentActiveDelegators av
 
+delegatorTotalCapital :: (AVSupportsDelegation av) => Lens' (PersistentActiveDelegators av) Amount
+delegatorTotalCapital f (PersistentActiveDelegatorsV1{..}) =
+    (\newDTC -> PersistentActiveDelegatorsV1{adDelegatorTotalCapital = newDTC, ..}) <$> f adDelegatorTotalCapital
+
 -- | See documentation of @migratePersistentBlockState@.
 migratePersistentActiveDelegators ::
     (BlobStorable m (), BlobStorable (t m) (), MonadTrans t) =>
@@ -475,11 +479,11 @@ addDelegatorUnsafe ::
     Amount ->
     PersistentActiveBakers av ->
     m (PersistentActiveBakers av)
-addDelegatorUnsafe dt did amt pab = do
-    res <- addDelegator dt did amt pab
-    case res of
-        Left bid -> error $ "addDelegatorUnsafe: Invalid baker id: " ++ show bid
-        Right pab' -> return pab'
+addDelegatorUnsafe DelegatePassive did amt = passiveDelegators (addDelegatorHelper did amt)
+addDelegatorUnsafe (DelegateToBaker bid) did amt = activeBakers (fmap snd . Trie.adjust upd bid)
+  where
+    upd Nothing = error "addDelegatorUnsafe: Baker not found"
+    upd (Just pad) = ((),) . Trie.Insert <$> addDelegatorHelper did amt pad
 
 -- | A helper function that removes a delegator from a 'PersistentActiveDelegators'.
 --  It is assumed that the delegator is in the delegators with the specified amount.
@@ -513,6 +517,23 @@ removeDelegator (DelegateToBaker bid) did amt pab = do
     newActiveBakers <- snd <$> Trie.adjust rdh bid (pab ^. activeBakers)
     return $ pab & activeBakers .~ newActiveBakers
 
+-- | Modify the total capital of a pool. The pool MUST already exist.
+--
+--  IMPORTANT: This does not update the total active capital!
+modifyPoolCapitalUnsafe ::
+    (MonadBlobStore m, IsAccountVersion av, AVSupportsDelegation av) =>
+    DelegationTarget ->
+    (Amount -> Amount) ->
+    PersistentActiveBakers av ->
+    m (PersistentActiveBakers av)
+modifyPoolCapitalUnsafe DelegatePassive change =
+    pure . (passiveDelegators . delegatorTotalCapital %~ change)
+modifyPoolCapitalUnsafe (DelegateToBaker bid) change =
+    activeBakers (fmap snd . Trie.adjust upd bid)
+  where
+    upd Nothing = error "modifyPoolCapitalUnsafe: Baker not found"
+    upd (Just pad) = pure . ((),) . Trie.Insert $ pad & delegatorTotalCapital %~ change
+
 -- | Transfer all delegators from a baker to passive delegation in the 'PersistentActiveBakers'. This does
 --  not affect the total stake, and does not remove the baker itself. This returns the list of
 --  affected delegators.  (This will have no effect if the baker is not actually a baker, although
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
index f5f056c35..d15ce2e66 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
@@ -1529,73 +1529,6 @@ data BakerConfigureFailure
     | BCFDuplicateAggregationKey !BakerAggregationVerifyKey
     | BCFChangePending
 
-configureBakerChecks ::
-    forall pv m.
-    ( SupportsPersistentState pv m,
-      PoolParametersVersionFor (ChainParametersVersionFor pv) ~ 'PoolParametersVersion1
-    ) =>
-    BlockStatePointers pv ->
-    ChainParameters pv ->
-    PersistentAccount (AccountVersionFor pv) ->
-    BakerConfigure ->
-    MTL.ExceptT BakerConfigureFailure m ()
-configureBakerChecks bsp chainParams _ BakerConfigureAdd{..}
-    -- Check if the equity capital is below the minimum threshold.
-    | bcaCapital < capitalMin = MTL.throwError BCFStakeUnderThreshold
-    -- Check if the transaction fee commission rate is in the acceptable range.
-    | not (isInRange bcaTransactionFeeCommission (ranges ^. transactionCommissionRange)) =
-        MTL.throwError BCFTransactionFeeCommissionNotInRange
-    -- Check if the baking reward commission rate is in the acceptable range.
-    | not (isInRange bcaBakingRewardCommission (ranges ^. bakingCommissionRange)) =
-        MTL.throwError BCFBakingRewardCommissionNotInRange
-    -- Check if the finalization reward commission rate is in the acceptable range.
-    | not (isInRange bcaFinalizationRewardCommission (ranges ^. finalizationCommissionRange)) =
-        MTL.throwError BCFFinalizationRewardCommissionNotInRange
-    | otherwise = do
-        -- Check if the aggregation key is fresh.
-        pab <- refLoad (_birkActiveBakers (bspBirkParameters bsp))
-        existingAggKey <- isJust <$> Trie.lookup (bkuAggregationKey bcaKeys) (_aggregationKeys pab)
-        when existingAggKey $
-            MTL.throwError (BCFDuplicateAggregationKey (bkuAggregationKey bcaKeys))
-  where
-    poolParams = chainParams ^. cpPoolParameters
-    capitalMin = poolParams ^. ppMinimumEquityCapital
-    ranges = poolParams ^. ppCommissionBounds
-configureBakerChecks bsp chainParams acc BakerConfigureUpdate{..} = do
-    -- The account must have a baker in the case of BakerConfigureUpdate.
-    baker <- fromJust <$> accountBaker acc
-    -- Check if the aggregation key is fresh (or the same as the baker's existing one).
-    forM_ bcuKeys $ \BakerKeyUpdate{..} ->
-        when (baker ^. BaseAccounts.bakerAggregationVerifyKey /= bkuAggregationKey) $ do
-            pab <- refLoad (_birkActiveBakers (bspBirkParameters bsp))
-            existingAggKey <- isJust <$> Trie.lookup bkuAggregationKey (_aggregationKeys pab)
-            when existingAggKey $
-                MTL.throwError (BCFDuplicateAggregationKey bkuAggregationKey)
-    -- Check if the transaction fee commission rate is in the acceptable range.
-    forM_ bcuTransactionFeeCommission $ \tfc ->
-        unless (isInRange tfc (ranges ^. transactionCommissionRange)) $
-            MTL.throwError BCFTransactionFeeCommissionNotInRange
-    -- Check if the baking reward commission rate is in the acceptable range.
-    forM_ bcuBakingRewardCommission $ \brc ->
-        unless (isInRange brc (ranges ^. bakingCommissionRange)) $
-            MTL.throwError BCFBakingRewardCommissionNotInRange
-    -- Check if the finalization reward commission rate is in the acceptable range.
-    forM_ bcuFinalizationRewardCommission $ \frc ->
-        unless (isInRange frc (ranges ^. finalizationCommissionRange)) $
-            MTL.throwError BCFFinalizationRewardCommissionNotInRange
-    forM_ bcuCapital $ \capital -> do
-        -- Check that there is no pending change on the account already.
-        case baker ^. BaseAccounts.bakerPendingChange of
-            BaseAccounts.NoChange -> return ()
-            _ -> MTL.throwError BCFChangePending
-        -- Check that the baker's equity capital is above the minimum threshold.
-        when (capital < capitalMin) $
-            MTL.throwError BCFStakeUnderThreshold
-  where
-    poolParams = chainParams ^. cpPoolParameters
-    capitalMin = poolParams ^. ppMinimumEquityCapital
-    ranges = poolParams ^. ppCommissionBounds
-
 addValidatorChecks ::
     forall pv m.
     ( SupportsPersistentState pv m,
@@ -1634,8 +1567,8 @@ addValidatorChecks bsp ValidatorAdd{..} = do
         )
         $ MTL.throwError BCFFinalizationRewardCommissionNotInRange
     -- Check if the aggregation key is fresh.
-    pab <- refLoad (_birkActiveBakers (bspBirkParameters bsp))
-    existingAggKey <- isJust <$> Trie.lookup (bkuAggregationKey vaKeys) (_aggregationKeys pab)
+    pab <- refLoad $ bspBirkParameters bsp ^. birkActiveBakers
+    existingAggKey <- isJust <$> Trie.lookup (bkuAggregationKey vaKeys) (pab ^. aggregationKeys)
     when existingAggKey $
         MTL.throwError (BCFDuplicateAggregationKey (bkuAggregationKey vaKeys))
 
@@ -1656,16 +1589,17 @@ newAddValidator ::
 newAddValidator pbs ai va@ValidatorAdd{..} = do
     bsp <- loadPBS pbs
     addValidatorChecks bsp va
-    pab <- refLoad (bspBirkParameters bsp ^. birkActiveBakers)
-    newAggregationKeys <- Trie.insert (bkuAggregationKey vaKeys) () (pab ^. aggregationKeys)
-    newActiveBakers <- Trie.insert bid emptyPersistentActiveDelegators (pab ^. activeBakers)
-    newPABref <-
-        refMake $
-            pab
-                & aggregationKeys .~ newAggregationKeys
-                & activeBakers .~ newActiveBakers
-                & totalActiveCapital %~ addActiveCapital vaCapital
-    let newBirkParams = bspBirkParameters bsp & birkActiveBakers .~ newPABref
+    newBirkParams <- do
+        pab <- refLoad (bspBirkParameters bsp ^. birkActiveBakers)
+        newAggregationKeys <- Trie.insert (bkuAggregationKey vaKeys) () (pab ^. aggregationKeys)
+        newActiveBakers <- Trie.insert bid emptyPersistentActiveDelegators (pab ^. activeBakers)
+        newPABref <-
+            refMake $
+                pab
+                    & aggregationKeys .~ newAggregationKeys
+                    & activeBakers .~ newActiveBakers
+                    & totalActiveCapital %~ addActiveCapital vaCapital
+        return $ bspBirkParameters bsp & birkActiveBakers .~ newPABref
     let poolInfo =
             BaseAccounts.BakerPoolInfo
                 { _poolOpenStatus = vaOpenForDelegation,
@@ -1677,7 +1611,7 @@ newAddValidator pbs ai va@ValidatorAdd{..} = do
     acc <- fromJust <$> Accounts.indexedAccount ai (bspAccounts bsp)
     -- Add the baker to the account.
     accWithBaker <- addAccountBakerV1 bakerInfoEx vaCapital vaRestakeEarnings acc
-    (accUpdated, newAIC) <- case sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv)) of
+    (accUpdated, newAIC) <- case flexibleCooldowns of
         SFalse -> return (accWithBaker, bspAccountsInCooldown bsp)
         STrue -> do
             -- Reactivate stake in cooldown to cover the new stake.
@@ -1696,6 +1630,7 @@ newAddValidator pbs ai va@ValidatorAdd{..} = do
             }
   where
     bid = BakerId ai
+    flexibleCooldowns = sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv))
 
 updateValidatorChecks ::
     forall pv m.
@@ -1715,10 +1650,9 @@ updateValidatorChecks bsp baker ValidatorUpdate{..} = do
     -- Check if the aggregation key is fresh (or the same as the baker's existing one).
     forM_ vuKeys $ \BakerKeyUpdate{..} ->
         when (baker ^. BaseAccounts.bakerAggregationVerifyKey /= bkuAggregationKey) $ do
-            pab <- refLoad (_birkActiveBakers (bspBirkParameters bsp))
-            existingAggKey <- isJust <$> Trie.lookup bkuAggregationKey (_aggregationKeys pab)
-            when existingAggKey $
-                MTL.throwError (BCFDuplicateAggregationKey bkuAggregationKey)
+            pab <- refLoad $ bspBirkParameters bsp ^. birkActiveBakers
+            existingAggKey <- isJust <$> Trie.lookup bkuAggregationKey (pab ^. aggregationKeys)
+            when existingAggKey $ MTL.throwError (BCFDuplicateAggregationKey bkuAggregationKey)
     -- Check if the transaction fee commission rate is in the acceptable range.
     forM_ vuTransactionFeeCommission $ \tfc ->
         unless (isInRange tfc (ranges ^. transactionCommissionRange)) $
@@ -1780,19 +1714,19 @@ newUpdateValidator pbs curTimestamp ai vu@ValidatorUpdate{..} = do
             if bkuAggregationKey keys == oldAggrKey
                 then return bsp
                 else do
-                    pab <- refLoad (_birkActiveBakers (bspBirkParameters bsp))
+                    pab <- refLoad $ bspBirkParameters bsp ^. birkActiveBakers
                     newAggregationKeys <-
                         Trie.insert (bkuAggregationKey keys) ()
-                            =<< Trie.delete oldAggrKey (_aggregationKeys pab)
+                            =<< Trie.delete oldAggrKey (pab ^. aggregationKeys)
                     newPABref <- refMake $ pab & aggregationKeys .~ newAggregationKeys
                     return $
                         bsp{bspBirkParameters = bspBirkParameters bsp & birkActiveBakers .~ newPABref}
         acc1 <- setAccountBakerKeys keys acc
         MTL.tell [BakerConfigureUpdateKeys keys]
         return (bsp1, acc1)
-    updateRestakeEarnings = ifPresent vuRestakeEarnings $ \re (bsp, acc) -> do
-        acc1 <- setAccountRestakeEarnings re acc
-        MTL.tell [BakerConfigureRestakeEarnings re]
+    updateRestakeEarnings = ifPresent vuRestakeEarnings $ \restakeEarnings (bsp, acc) -> do
+        acc1 <- setAccountRestakeEarnings restakeEarnings acc
+        MTL.tell [BakerConfigureRestakeEarnings restakeEarnings]
         return (bsp, acc1)
     updatePoolInfo oldBaker (bsp0, acc) = do
         let pu0 = emptyBakerPoolInfoUpdate
@@ -1839,6 +1773,7 @@ newUpdateValidator pbs curTimestamp ai vu@ValidatorUpdate{..} = do
                 else return (bsp, pu{updFinalizationRewardCommission = Just frc})
     updateCapital = updateCapital' (sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv)))
     updateCapital' SFalse oldBaker = ifPresent vuCapital $ \capital (bsp, acc) -> do
+        -- No flexible cooldowns. Reducing stake creates a pending change.
         cp <- lookupCurrentParameters (bspUpdates bsp)
         let cooldownDuration = cp ^. cpCooldownParameters . cpPoolOwnerCooldown
             cooldownElapsed =
@@ -1871,14 +1806,14 @@ newUpdateValidator pbs curTimestamp ai vu@ValidatorUpdate{..} = do
                     acc1 <- setAccountStake capital acc
                     return (bsp1, acc1)
     updateCapital' STrue oldBaker = ifPresent vuCapital $ \capital (bsp, acc) -> do
+        -- Flexible cooldowns. Reducing stake goes into cooldown, and increasing stake reactivates
+        -- stake from cooldown.
         let oldCapital = oldBaker ^. BaseAccounts.stakedAmount
         if capital == 0
             then do
                 MTL.tell [BakerConfigureStakeReduced 0]
                 alreadyInPrePreCooldown <- accountHasPrePreCooldown acc
-                acc1 <-
-                    removeAccountStake acc
-                        >>= addAccountPrePreCooldown oldCapital
+                acc1 <- removeAccountStake acc >>= addAccountPrePreCooldown oldCapital
                 bsp1 <- moveDelegatorsToPassive bsp (Just oldCapital)
                 bsp2 <- (if alreadyInPrePreCooldown then return else addToPrePreCooldowns) bsp1
                 return (bsp2, acc1)
@@ -1931,6 +1866,7 @@ newUpdateValidator pbs curTimestamp ai vu@ValidatorUpdate{..} = do
         BlockStatePointers pv ->
         m' (BlockStatePointers pv)
     addToPrePreCooldowns bsp = do
+        -- Add the account to the pre-pre-cooldowns list.
         newAccountsInCooldown <-
             (accountsInCooldown . prePreCooldown)
                 (consAccountList ai)
@@ -2497,6 +2433,7 @@ data DelegatorConfigureFailure
     | DCFPoolClosed
     | DCFPoolStakeOverThreshold
     | DCFPoolOverDelegated
+    | DCFChangePending
 
 addDelegatorChecks ::
     ( IsProtocolVersion pv,
@@ -2591,33 +2528,34 @@ updateDelegatorChecks ::
     forall pv m.
     ( IsProtocolVersion pv,
       PVSupportsDelegation pv,
-      MTL.MonadError DelegationConfigureResult m,
+      MTL.MonadError DelegatorConfigureFailure m,
       SupportsPersistentAccount pv m,
-      ChainParametersVersionFor pv ~ 'ChainParametersV1
+      PoolParametersVersionFor (ChainParametersVersionFor pv) ~ 'PoolParametersVersion1
     ) =>
     BlockStatePointers pv ->
-    PersistentAccount (AccountVersionFor pv) ->
+    BaseAccounts.AccountDelegation (AccountVersionFor pv) ->
     DelegatorUpdate ->
     m ()
-updateDelegatorChecks bsp acc DelegatorUpdate{..} = do
-    -- Cannot fail: the account must already be a delegator.
-    oldDelegator <- fromJust <$> accountDelegator acc
+updateDelegatorChecks bsp oldDelegator DelegatorUpdate{..} = do
     -- Check that the delegation target is valid and open.
-    (mTargetBaker) <- case duDelegationTarget of
+    -- This returns @Just (baker, sameBaker)@ if the (new) delegation target is a baker (@baker@),
+    -- with @sameBaker@ indicating whether the delegator is still delegating to the same pool.
+    -- If the target is passive delegation, it returns @Nothing@.
+    mTargetBaker <- case duDelegationTarget of
         Nothing -> case oldDelegator ^. BaseAccounts.delegationTarget of
             Transactions.DelegatePassive -> return Nothing
-            Transactions.DelegateToBaker bid -> do
+            Transactions.DelegateToBaker (BakerId baid) -> do
                 -- Cannot fail: the account must delegate to a valid baker.
-                baker <- fromJust <$> onAccount baid bps accountBaker
+                baker <- fromJust <$> onAccount baid bsp accountBaker
                 -- Since it wasn't changed, the baker is the same as before.
                 return (Just (baker, True))
         Just Transactions.DelegatePassive -> return Nothing
-        Just (Transactions.DelegateToBaker bid) -> do
+        Just (Transactions.DelegateToBaker bid@(BakerId baid)) -> do
             onAccount baid bsp accountBaker >>= \case
-                Nothing -> MTL.throwError (DCInvalidDelegationTarget bid)
+                Nothing -> MTL.throwError (DCFInvalidDelegationTarget bid)
                 Just baker -> do
                     unless (baker ^. BaseAccounts.poolOpenStatus == Transactions.OpenForAll) $
-                        MTL.throwError DCPoolClosed
+                        MTL.throwError DCFPoolClosed
                     let sameBaker =
                             Transactions.DelegateToBaker bid
                                 == oldDelegator ^. BaseAccounts.delegationTarget
@@ -2625,7 +2563,7 @@ updateDelegatorChecks bsp acc DelegatorUpdate{..} = do
     -- If the capital is being changed, check there is not a pending change.
     let hasPendingChange =
             oldDelegator ^. BaseAccounts.delegationPendingChange /= BaseAccounts.NoChange
-    when (isJust duCapital && hasPendingChange) $ MTL.throwError DCChangePending
+    when (isJust duCapital && hasPendingChange) $ MTL.throwError DCFChangePending
     -- If the target is a baker pool, check that the delegation amount is within bounds.
     forM_ mTargetBaker $ \(baker, sameBaker) -> do
         let oldStake = oldDelegator ^. BaseAccounts.delegationStakedAmount
@@ -2637,23 +2575,171 @@ updateDelegatorChecks bsp acc DelegatorUpdate{..} = do
         let newEffectiveStake = case duCapital of
                 Nothing -> oldStake
                 Just newStake -> case flexibleCooldown of
-                    SFalse | newStake <= oldStake -> oldStake
-                    _ -> newStake
-        -- The change to the total staked capital.
-        let delta = newEffectiveStake `amountDiff` oldStake
-        -- The change to the pool's staked capital. This depends on whether the delegator is
-        -- switching pools.
-        let poolDelta = if sameBaker then delta else amountToDelta newEffectiveStake
-        poolParams <- _cpPoolParameters <$> lookupCurrentParameters (bspUpdates bsp)
-        let bakerEquityCapital = baker ^. BaseAccounts.stakedAmount
-        bakerDelegatedCapital <- applyAmountDelta poolDelta <$> poolDelegatorCapital bsp bid
-        capitalTotal <- applyAmountDelta delta <$> totalCapital bsp
-        let PoolCaps{..} =
-                delegatedCapitalCaps poolParams capitalTotal bakerEquityCapital bakerDelegatedCapital
-        when (bakerDelegatedCapital > leverageCap) $ MTL.throwError DCPoolStakeOverThreshold
-        when (bakerDelegatedCapital > boundCap) $ MTL.throwError DCPoolOverDelegated
+                    SFalse -> max newStake oldStake -- If the stake is reduced, the change is pending.
+                    STrue -> newStake
+        -- We only check for over-delegation if the stake is being increased or the target is
+        -- is changed.
+        unless (sameBaker && newEffectiveStake <= oldStake) $ do
+            -- The change to the total staked capital.
+            let delta = newEffectiveStake `amountDiff` oldStake
+            -- The change to the pool's staked capital. This depends on whether the delegator is
+            -- switching pools.
+            let poolDelta = if sameBaker then delta else amountToDelta newEffectiveStake
+            poolParams <- _cpPoolParameters <$> lookupCurrentParameters (bspUpdates bsp)
+            let bakerEquityCapital = baker ^. BaseAccounts.stakedAmount
+            let bid = baker ^. BaseAccounts.bakerIdentity
+            bakerDelegatedCapital <- applyAmountDelta poolDelta <$> poolDelegatorCapital bsp bid
+            capitalTotal <- applyAmountDelta delta <$> totalCapital bsp
+            let PoolCaps{..} =
+                    delegatedCapitalCaps poolParams capitalTotal bakerEquityCapital bakerDelegatedCapital
+            when (bakerDelegatedCapital > leverageCap) $ MTL.throwError DCFPoolStakeOverThreshold
+            when (bakerDelegatedCapital > boundCap) $ MTL.throwError DCFPoolOverDelegated
+  where
+    flexibleCooldown = sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv))
+
+newUpdateDelegator ::
+    forall pv m.
+    ( SupportsPersistentState pv m,
+      PVSupportsDelegation pv,
+      IsSupported 'PTTimeParameters (ChainParametersVersionFor pv) ~ 'True,
+      PoolParametersVersionFor (ChainParametersVersionFor pv) ~ 'PoolParametersVersion1,
+      CooldownParametersVersionFor (ChainParametersVersionFor pv) ~ 'CooldownParametersVersion1
+    ) =>
+    PersistentBlockState (MPV m) ->
+    -- | Current block timestamp
+    Timestamp ->
+    AccountIndex ->
+    DelegatorUpdate ->
+    MTL.ExceptT DelegatorConfigureFailure m ([DelegationConfigureUpdateChange], PersistentBlockState (MPV m))
+newUpdateDelegator pbs blockTimestamp ai du@DelegatorUpdate{..} = do
+    bsp <- loadPBS pbs
+    -- Cannot fail: account must exist.
+    acc <- fromJust <$> Accounts.indexedAccount ai (bspAccounts bsp)
+    -- Cannot fail: the account must already be a delegator.
+    existingDelegator <- fromJust <$> accountDelegator acc
+    updateDelegatorChecks bsp existingDelegator du
+    (newBSP, events) <- lift . MTL.runWriterT $ do
+        (newBSP, newAcc) <-
+            updateDelegationTarget (existingDelegator ^. BaseAccounts.delegationTarget) (bsp, acc)
+                >>= updateRestakeEarnings
+                >>= updateCapital
+
+        newAccounts <- Accounts.setAccountAtIndex ai newAcc (bspAccounts newBSP)
+        return newBSP{bspAccounts = newAccounts}
+    (events,) <$> storePBS pbs newBSP
   where
+    did = DelegatorId ai
     flexibleCooldown = sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv))
+    ifPresent Nothing _ = return
+    ifPresent (Just v) k = k v
+    updateDelegationTarget oldTarget = ifPresent duDelegationTarget $ \target (bsp, acc) -> do
+        MTL.tell [DelegationConfigureDelegationTarget target]
+        stakedAmount <- accountActiveStakedAmount acc
+        if target == oldTarget || stakedAmount == 0
+            then return (bsp, acc)
+            else do
+                bsp1 <-
+                    onActiveBakers bsp $
+                        removeDelegator oldTarget did stakedAmount
+                            >=> addDelegatorUnsafe target did stakedAmount
+                acc1 <- setAccountDelegationTarget target acc
+                return (bsp1, acc1)
+    updateRestakeEarnings = ifPresent duRestakeEarnings $ \restakeEarnings (bsp, acc) -> do
+        MTL.tell [DelegationConfigureRestakeEarnings restakeEarnings]
+        acc1 <- setAccountRestakeEarnings restakeEarnings acc
+        return (bsp, acc1)
+    updateCapital = ifPresent duCapital $ \capital (bsp, acc) -> case flexibleCooldown of
+        SFalse -> do
+            chainParams <- lookupCurrentParameters (bspUpdates bsp)
+            oldCapital <- accountActiveStakedAmount acc
+            let cooldownDuration = chainParams ^. cpCooldownParameters . cpDelegatorCooldown
+                cooldownElapsed = addDurationSeconds blockTimestamp cooldownDuration
+                changeEffective = BaseAccounts.PendingChangeEffectiveV1 cooldownElapsed
+            if capital == 0
+                then do
+                    MTL.tell [DelegationConfigureStakeReduced capital]
+                    let dpc = BaseAccounts.RemoveStake changeEffective
+                    acc1 <- setAccountStakePendingChange dpc acc
+                    return (bsp, acc1)
+                else case compare capital oldCapital of
+                    LT -> do
+                        MTL.tell [DelegationConfigureStakeReduced capital]
+                        let dpc = BaseAccounts.ReduceStake capital changeEffective
+                        acc1 <- setAccountStakePendingChange dpc acc
+                        return (bsp, acc1)
+                    EQ -> do
+                        MTL.tell [DelegationConfigureStakeIncreased capital]
+                        return (bsp, acc)
+                    GT -> do
+                        MTL.tell [DelegationConfigureStakeIncreased capital]
+                        -- Cannot fail: account must already be a delegator.
+                        target <- BaseAccounts._delegationTarget . fromJust <$> accountDelegator acc
+                        let change = capital - oldCapital
+                        bsp1 <-
+                            onActiveBakers bsp $
+                                fmap (totalActiveCapital %~ addActiveCapital change)
+                                    . modifyPoolCapitalUnsafe target (+ change)
+                        acc1 <- setAccountStake capital acc
+                        return (bsp1, acc1)
+        STrue -> do
+            oldCapital <- accountActiveStakedAmount acc
+            target <- BaseAccounts._delegationTarget . fromJust <$> accountDelegator acc
+            if capital == 0
+                then do
+                    MTL.tell [DelegationConfigureStakeReduced 0]
+                    bsp1 <-
+                        onActiveBakers bsp $
+                            removeDelegator target did oldCapital
+                                . (totalActiveCapital %~ subtractActiveCapital oldCapital)
+
+                    alreadyInPrePreCooldown <- accountHasPrePreCooldown acc
+                    acc1 <- removeAccountStake acc >>= addAccountPrePreCooldown oldCapital
+                    bsp2 <- (if alreadyInPrePreCooldown then return else addToPrePreCooldowns) bsp1
+                    return (bsp2, acc1)
+                else case compare capital oldCapital of
+                    LT -> do
+                        MTL.tell [DelegationConfigureStakeReduced capital]
+                        let delta = oldCapital - capital
+                        bsp1 <-
+                            onActiveBakers bsp $
+                                fmap (totalActiveCapital %~ subtractActiveCapital delta)
+                                    . modifyPoolCapitalUnsafe target (subtract delta)
+                        alreadyInPrePreCooldown <- accountHasPrePreCooldown acc
+                        acc1 <- setAccountStake capital acc >>= addAccountPrePreCooldown delta
+                        bsp2 <- (if alreadyInPrePreCooldown then return else addToPrePreCooldowns) bsp1
+                        return (bsp2, acc1)
+                    EQ -> do
+                        MTL.tell [DelegationConfigureStakeIncreased capital]
+                        return (bsp, acc)
+                    GT -> do
+                        MTL.tell [DelegationConfigureStakeIncreased capital]
+                        let delta = capital - oldCapital
+                        bsp1 <-
+                            onActiveBakers bsp $
+                                fmap (totalActiveCapital %~ addActiveCapital delta)
+                                    . modifyPoolCapitalUnsafe target (+ delta)
+                        maybeCooldownsBefore <- accountCooldowns acc
+                        acc1 <-
+                            setAccountStake capital acc
+                                >>= reactivateCooldownAmount delta
+                        maybeCooldownsAfter <- accountCooldowns acc1
+                        let removals = cooldownRemovals maybeCooldownsBefore maybeCooldownsAfter
+                        newCooldowns <- applyCooldownRemovalsGlobally ai removals (bspAccountsInCooldown bsp1)
+                        return (bsp1{bspAccountsInCooldown = newCooldowns}, acc1)
+    onActiveBakers bsp f = do
+        newPABRef <- refMake =<< f =<< refLoad (bspBirkParameters bsp ^. birkActiveBakers)
+        return bsp{bspBirkParameters = bspBirkParameters bsp & birkActiveBakers .~ newPABRef}
+    addToPrePreCooldowns ::
+        (MonadBlobStore m', PVSupportsFlexibleCooldown pv) =>
+        BlockStatePointers pv ->
+        m' (BlockStatePointers pv)
+    addToPrePreCooldowns bsp = do
+        -- Add the account to the pre-pre-cooldowns list.
+        newAccountsInCooldown <-
+            (accountsInCooldown . prePreCooldown)
+                (consAccountList ai)
+                (bspAccountsInCooldown bsp)
+        return bsp{bspAccountsInCooldown = newAccountsInCooldown}
 
 doConfigureDelegation ::
     forall pv m.

From 3883c9456a2dbf0cb3fe3b99962b71f04b4016fd Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Wed, 24 Jul 2024 17:44:16 +0200
Subject: [PATCH 36/81] Scheduler changes to configure baker/delegator in
 progress.

---
 .../src/Concordium/GlobalState/BakerInfo.hs   |  40 ++++
 .../src/Concordium/GlobalState/BlockState.hs  | 111 +++++++++++
 .../GlobalState/Persistent/BlockState.hs      |  53 +++--
 .../src/Concordium/Scheduler.hs               | 187 ++++++++----------
 .../src/Concordium/Scheduler/Environment.hs   |  62 +++++-
 .../Scheduler/EnvironmentImplementation.hs    |  44 +++--
 6 files changed, 342 insertions(+), 155 deletions(-)

diff --git a/concordium-consensus/src/Concordium/GlobalState/BakerInfo.hs b/concordium-consensus/src/Concordium/GlobalState/BakerInfo.hs
index 7cf099a6a..43732db53 100644
--- a/concordium-consensus/src/Concordium/GlobalState/BakerInfo.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/BakerInfo.hs
@@ -111,6 +111,15 @@ data BakerKeyUpdate = BakerKeyUpdate
     }
     deriving (Eq, Ord, Show)
 
+-- | Extract the 'BakerKeyUpdate' from a 'BakerKeysWithProofs'.
+bakerKeysWithoutProofs :: BakerKeysWithProofs -> BakerKeyUpdate
+bakerKeysWithoutProofs BakerKeysWithProofs{..} =
+    BakerKeyUpdate
+        { bkuSignKey = bkwpSignatureVerifyKey,
+          bkuAggregationKey = bkwpAggregationVerifyKey,
+          bkuElectionKey = bkwpElectionVerifyKey
+        }
+
 data BakerKeyUpdateResult
     = -- | The keys were updated successfully
       BKUSuccess !BakerId
@@ -213,6 +222,22 @@ data ValidatorUpdate = ValidatorUpdate
     }
     deriving (Eq, Show)
 
+-- | Failure modes when configuring a validator.
+data ValidatorConfigureFailure
+    = -- | The stake is below the required threshold dictated by current chain parameters.
+      VCFStakeUnderThreshold
+    | -- | The transaction fee commission is not in the allowed range.
+      VCFTransactionFeeCommissionNotInRange
+    | -- | The baking reward commission is not in the allowed range.
+      VCFBakingRewardCommissionNotInRange
+    | -- | The finalization reward commission is not in the allowed range.
+      VCFFinalizationRewardCommissionNotInRange
+    | -- | The aggregation key is already in use by another validator.
+      VCFDuplicateAggregationKey !BakerAggregationVerifyKey
+    | -- | A change is already pending on this validator.
+      VCFChangePending
+    deriving (Eq, Show)
+
 -- | Data structure used to add/remove/update baker.
 data BakerConfigure
     = -- | Add a baker, all fields are required.
@@ -337,6 +362,21 @@ data DelegationConfigureUpdateChange
     | DelegationConfigureDelegationTarget !DelegationTarget
     deriving (Eq, Show)
 
+-- | Failure modes for configuring a delegator.
+data DelegatorConfigureFailure
+    = -- | The delegation target is not a valid baker.
+      DCFInvalidDelegationTarget !BakerId
+    | -- | The pool is not open for delegators.
+      DCFPoolClosed
+    | -- | The pool's total capital would become too large.
+      DCFPoolStakeOverThreshold
+    | -- | The delegated capital would become too large in comparison with pool owner's equity
+      -- capital.
+      DCFPoolOverDelegated
+    | -- | A change is already pending on this delegator.
+      DCFChangePending
+    deriving (Eq, Show)
+
 -- | Result of configure delegator.
 data DelegationConfigureResult
     = -- | Configure delegation successful.
diff --git a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs
index 16e9dc24c..a6e9480fc 100644
--- a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs
@@ -1063,6 +1063,98 @@ class (BlockStateQuery m) => BlockStateOperations m where
         BakerConfigure ->
         m (BakerConfigureResult, UpdatableBlockState m)
 
+    -- | From chain parameters version >= 1, this adds a validator for an account.
+    --
+    --  PRECONDITIONS:
+    --  * the account is valid;
+    --  * the account is not a baker;
+    --  * the account is not a delegator;
+    --  * the account has sufficient balance to cover the stake.
+    --
+    --  The function behaves as follows:
+    --
+    --  1. If the baker's capital is less than the minimum threshold, return 'VCFStakeUnderThreshold'.
+    --  2. If the transaction fee commission is not in the acceptable range, return
+    --     'VCFTransactionFeeCommissionNotInRange'.
+    --  3. If the baking reward commission is not in the acceptable range, return
+    --     'VCFBakingRewardCommissionNotInRange'.
+    --  4. If the finalization reward commission is not in the acceptable range, return
+    --     'VCFFinalizationRewardCommissionNotInRange'.
+    --  5. If the aggregation key is a duplicate, return 'VCFDuplicateAggregationKey'.
+    --  6. Add the baker to the account, updating the indexes as follows:
+    --     * add an empty pool for the baker in the active bakers;
+    --     * add the baker's equity capital to the total active capital;
+    --     * add the baker's aggregation key to the aggregation key set.
+    bsoAddValidator ::
+        (PVSupportsDelegation (MPV m)) =>
+        UpdatableBlockState m ->
+        AccountIndex ->
+        ValidatorAdd ->
+        m (Either ValidatorConfigureFailure (UpdatableBlockState m))
+
+    -- | Update the validator for an account.
+    --
+    --  PRECONDITIONS:
+    --  * the account is valid;
+    --  * the account is a baker;
+    --  * if the stake is being updated, then the account balance exceeds the new stake.
+    --
+    --  The function behaves as follows, building a list @events@:
+    --
+    --  1. If keys are supplied: if the aggregation key duplicates an existing aggregation key @key@
+    --     (except this baker's current aggregation key), return @BCDuplicateAggregationKey key@;
+    --     otherwise, update the keys with the supplied @keys@, update the aggregation key index
+    --     (removing the old key and adding the new one), and append @BakerConfigureUpdateKeys keys@
+    --     to @events@.
+    --  2. If the restake earnings flag is supplied: update the account's flag to the supplied value
+    --     @restakeEarnings@ and append @BakerConfigureRestakeEarnings restakeEarnings@ to @events@.
+    --  3. If the open-for-delegation configuration is supplied:
+    --     (1) update the account's configuration to the supplied value @openForDelegation@;
+    --     (2) if @openForDelegation == ClosedForAll@, transfer all delegators in the baker's pool to
+    --         passive delegation; and
+    --     (3) append @BakerConfigureOpenForDelegation openForDelegation@ to @events@.
+    --  4. If the metadata URL is supplied: update the account's metadata URL to the supplied value
+    --     @metadataURL@ and append @BakerConfigureMetadataURL metadataURL@ to @events@.
+    --  5. If the transaction fee commission is supplied:
+    --     (1) if the commission does not fall within the current range according to the chain
+    --         parameters, return @BCTransactionFeeCommissionNotInRange@; otherwise,
+    --     (2) update the account's transaction fee commission rate to the the supplied value @tfc@;
+    --     (3) append @BakerConfigureTransactionFeeCommission tfc@ to @events@.
+    --  6. If the baking reward commission is supplied:
+    --     (1) if the commission does not fall within the current range according to the chain
+    --         parameters, return @BCBakingRewardCommissionNotInRange@; otherwise,
+    --     (2) update the account's baking reward commission rate to the the supplied value @brc@;
+    --     (3) append @BakerConfigureBakingRewardCommission brc@ to @events@.
+    --  6. If the finalization reward commission is supplied:
+    --     (1) if the commission does not fall within the current range according to the chain
+    --         parameters, return @BCFinalizationRewardCommissionNotInRange@; otherwise,
+    --     (2) update the account's finalization reward commission rate to the the supplied value @frc@;
+    --     (3) append @BakerConfigureFinalizationRewardCommission frc@ to @events@.
+    --  7. If the capital is supplied: if there is a pending change to the baker's capital, return
+    --     @BCChangePending@; otherwise:
+    --     * if the capital is 0, mark the baker as pending removal at @bcuSlotTimestamp@ plus the
+    --       the current baker cooldown period according to the chain parameters, and append
+    --       @BakerConfigureStakeReduced 0@ to @events@;
+    --     * if the capital is less than the current minimum equity capital, return @BCStakeUnderThreshold@;
+    --     * if the capital is (otherwise) less than the current equity capital of the baker, mark the
+    --       baker as pending stake reduction to the new capital at @bcuSlotTimestamp@ plus the
+    --       current baker cooldown period according to the chain parameters and append
+    --       @BakerConfigureStakeReduced capital@ to @events@;
+    --     * if the capital is equal to the baker's current equity capital, do nothing, append
+    --       @BakerConfigureStakeIncreased capital@ to @events@;
+    --     * if the capital is greater than the baker's current equity capital, increase the baker's
+    --       equity capital to the new capital (updating the total active capital in the active baker
+    --       index by adding the difference between the new and old capital) and append
+    --       @BakerConfigureStakeIncreased capital@ to @events@.
+    --  8. return @BCSuccess events bid@, where @bid@ is the baker's ID.
+    bsoUpdateValidator ::
+        (PVSupportsDelegation (MPV m)) =>
+        UpdatableBlockState m ->
+        Timestamp ->
+        AccountIndex ->
+        ValidatorUpdate ->
+        m (Either ValidatorConfigureFailure ([BakerConfigureUpdateChange], UpdatableBlockState m))
+
     -- | Constrain the baker's commission rates to fall in the given ranges.
     --  If the account is invalid or not a baker, this does nothing.
     bsoConstrainBakerCommission ::
@@ -1153,6 +1245,21 @@ class (BlockStateQuery m) => BlockStateOperations m where
         DelegationConfigure ->
         m (DelegationConfigureResult, UpdatableBlockState m)
 
+    bsoAddDelegator ::
+        (PVSupportsDelegation (MPV m)) =>
+        UpdatableBlockState m ->
+        AccountIndex ->
+        DelegatorAdd ->
+        m (Either DelegatorConfigureFailure (UpdatableBlockState m))
+
+    bsoUpdateDelegator ::
+        (PVSupportsDelegation (MPV m)) =>
+        UpdatableBlockState m ->
+        Timestamp ->
+        AccountIndex ->
+        DelegatorUpdate ->
+        m (Either DelegatorConfigureFailure ([DelegationConfigureUpdateChange], UpdatableBlockState m))
+
     -- | Update the keys associated with an account.
     --  It is assumed that the keys have already been checked for validity/ownership as
     --  far as is necessary.
@@ -1648,7 +1755,11 @@ instance (Monad (t m), MonadTrans t, BlockStateOperations m) => BlockStateOperat
     bsoGetCurrentCapitalDistribution = lift . bsoGetCurrentCapitalDistribution
     bsoAddBaker s addr a = lift $ bsoAddBaker s addr a
     bsoConfigureBaker s aconfig a = lift $ bsoConfigureBaker s aconfig a
+    bsoAddValidator s ai a = lift $ bsoAddValidator s ai a
+    bsoUpdateValidator s ts ai upd = lift $ bsoUpdateValidator s ts ai upd
     bsoConstrainBakerCommission s acct ranges = lift $ bsoConstrainBakerCommission s acct ranges
+    bsoAddDelegator s ai a = lift $ bsoAddDelegator s ai a
+    bsoUpdateDelegator s ts ai a = lift $ bsoUpdateDelegator s ts ai a
     bsoConfigureDelegation s aconfig a = lift $ bsoConfigureDelegation s aconfig a
     bsoUpdateBakerKeys s addr a = lift $ bsoUpdateBakerKeys s addr a
     bsoUpdateBakerStake s addr a = lift $ bsoUpdateBakerStake s addr a
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
index d15ce2e66..0cbcec3f0 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
@@ -1521,14 +1521,6 @@ redelegatePassive accounts (DelegatorId accId) =
         accId
         accounts
 
-data BakerConfigureFailure
-    = BCFStakeUnderThreshold
-    | BCFTransactionFeeCommissionNotInRange
-    | BCFBakingRewardCommissionNotInRange
-    | BCFFinalizationRewardCommissionNotInRange
-    | BCFDuplicateAggregationKey !BakerAggregationVerifyKey
-    | BCFChangePending
-
 addValidatorChecks ::
     forall pv m.
     ( SupportsPersistentState pv m,
@@ -1536,7 +1528,7 @@ addValidatorChecks ::
     ) =>
     BlockStatePointers pv ->
     ValidatorAdd ->
-    MTL.ExceptT BakerConfigureFailure m ()
+    MTL.ExceptT ValidatorConfigureFailure m ()
 addValidatorChecks bsp ValidatorAdd{..} = do
     chainParams <- lookupCurrentParameters (bspUpdates bsp)
     let
@@ -1544,33 +1536,33 @@ addValidatorChecks bsp ValidatorAdd{..} = do
         capitalMin = poolParams ^. ppMinimumEquityCapital
         ranges = poolParams ^. ppCommissionBounds
     -- Check if the equity capital is below the minimum threshold.
-    when (vaCapital < capitalMin) $ MTL.throwError BCFStakeUnderThreshold
+    when (vaCapital < capitalMin) $ MTL.throwError VCFStakeUnderThreshold
     -- Check if the transaction fee commission rate is in the acceptable range.
     unless
         ( isInRange
             (vaCommissionRates ^. transactionCommission)
             (ranges ^. transactionCommissionRange)
         )
-        $ MTL.throwError BCFTransactionFeeCommissionNotInRange
+        $ MTL.throwError VCFTransactionFeeCommissionNotInRange
     -- Check if the baking reward commission rate is in the acceptable range.
     unless
         ( isInRange
             (vaCommissionRates ^. bakingCommission)
             (ranges ^. bakingCommissionRange)
         )
-        $ MTL.throwError BCFBakingRewardCommissionNotInRange
+        $ MTL.throwError VCFBakingRewardCommissionNotInRange
     -- Check if the finalization reward commission rate is in the acceptable range.
     unless
         ( isInRange
             (vaCommissionRates ^. finalizationCommission)
             (ranges ^. finalizationCommissionRange)
         )
-        $ MTL.throwError BCFFinalizationRewardCommissionNotInRange
+        $ MTL.throwError VCFFinalizationRewardCommissionNotInRange
     -- Check if the aggregation key is fresh.
     pab <- refLoad $ bspBirkParameters bsp ^. birkActiveBakers
     existingAggKey <- isJust <$> Trie.lookup (bkuAggregationKey vaKeys) (pab ^. aggregationKeys)
     when existingAggKey $
-        MTL.throwError (BCFDuplicateAggregationKey (bkuAggregationKey vaKeys))
+        MTL.throwError (VCFDuplicateAggregationKey (bkuAggregationKey vaKeys))
 
 -- |
 -- PRECONDITION: The account exists and is not currently a baker or delegator.
@@ -1585,7 +1577,7 @@ newAddValidator ::
     PersistentBlockState (MPV m) ->
     AccountIndex ->
     ValidatorAdd ->
-    MTL.ExceptT BakerConfigureFailure m (PersistentBlockState (MPV m))
+    MTL.ExceptT ValidatorConfigureFailure m (PersistentBlockState (MPV m))
 newAddValidator pbs ai va@ValidatorAdd{..} = do
     bsp <- loadPBS pbs
     addValidatorChecks bsp va
@@ -1640,7 +1632,7 @@ updateValidatorChecks ::
     BlockStatePointers pv ->
     AccountBaker (AccountVersionFor pv) ->
     ValidatorUpdate ->
-    MTL.ExceptT BakerConfigureFailure m ()
+    MTL.ExceptT ValidatorConfigureFailure m ()
 updateValidatorChecks bsp baker ValidatorUpdate{..} = do
     chainParams <- lookupCurrentParameters (bspUpdates bsp)
     let
@@ -1652,27 +1644,27 @@ updateValidatorChecks bsp baker ValidatorUpdate{..} = do
         when (baker ^. BaseAccounts.bakerAggregationVerifyKey /= bkuAggregationKey) $ do
             pab <- refLoad $ bspBirkParameters bsp ^. birkActiveBakers
             existingAggKey <- isJust <$> Trie.lookup bkuAggregationKey (pab ^. aggregationKeys)
-            when existingAggKey $ MTL.throwError (BCFDuplicateAggregationKey bkuAggregationKey)
+            when existingAggKey $ MTL.throwError (VCFDuplicateAggregationKey bkuAggregationKey)
     -- Check if the transaction fee commission rate is in the acceptable range.
     forM_ vuTransactionFeeCommission $ \tfc ->
         unless (isInRange tfc (ranges ^. transactionCommissionRange)) $
-            MTL.throwError BCFTransactionFeeCommissionNotInRange
+            MTL.throwError VCFTransactionFeeCommissionNotInRange
     -- Check if the baking reward commission rate is in the acceptable range.
     forM_ vuBakingRewardCommission $ \brc ->
         unless (isInRange brc (ranges ^. bakingCommissionRange)) $
-            MTL.throwError BCFBakingRewardCommissionNotInRange
+            MTL.throwError VCFBakingRewardCommissionNotInRange
     -- Check if the finalization reward commission rate is in the acceptable range.
     forM_ vuFinalizationRewardCommission $ \frc ->
         unless (isInRange frc (ranges ^. finalizationCommissionRange)) $
-            MTL.throwError BCFFinalizationRewardCommissionNotInRange
+            MTL.throwError VCFFinalizationRewardCommissionNotInRange
     forM_ vuCapital $ \capital -> do
         -- Check that there is no pending change on the account already.
         when (baker ^. BaseAccounts.bakerPendingChange /= BaseAccounts.NoChange) $
-            MTL.throwError BCFChangePending
+            MTL.throwError VCFChangePending
         -- Check that the baker's equity capital is above the minimum threshold, unless it
         -- is being removed.
         when (capital /= 0 && capital < capitalMin) $
-            MTL.throwError BCFStakeUnderThreshold
+            MTL.throwError VCFStakeUnderThreshold
 
 newUpdateValidator ::
     forall pv m.
@@ -1687,7 +1679,7 @@ newUpdateValidator ::
     Timestamp ->
     AccountIndex ->
     ValidatorUpdate ->
-    MTL.ExceptT BakerConfigureFailure m ([BakerConfigureUpdateChange], PersistentBlockState (MPV m))
+    MTL.ExceptT ValidatorConfigureFailure m ([BakerConfigureUpdateChange], PersistentBlockState (MPV m))
 newUpdateValidator pbs curTimestamp ai vu@ValidatorUpdate{..} = do
     bsp <- loadPBS pbs
     -- Cannot fail: account must exist.
@@ -2428,13 +2420,6 @@ delegationCheckTargetOpen bsp (Transactions.DelegateToBaker bid@(BakerId baid))
                 _ -> MTL.throwError DCPoolClosed
         _ -> MTL.throwError (DCInvalidDelegationTarget bid)
 
-data DelegatorConfigureFailure
-    = DCFInvalidDelegationTarget !BakerId
-    | DCFPoolClosed
-    | DCFPoolStakeOverThreshold
-    | DCFPoolOverDelegated
-    | DCFChangePending
-
 addDelegatorChecks ::
     ( IsProtocolVersion pv,
       PVSupportsDelegation pv,
@@ -4833,9 +4818,17 @@ instance (IsProtocolVersion pv, PersistentState av pv r m) => BlockStateOperatio
     bsoAddBaker = doAddBaker
     bsoConfigureBaker = case delegationChainParameters @pv of
         DelegationChainParameters -> doConfigureBaker
+    bsoAddValidator = case delegationChainParameters @pv of
+        DelegationChainParameters -> \bs ai a -> MTL.runExceptT (newAddValidator bs ai a)
+    bsoUpdateValidator = case delegationChainParameters @pv of
+        DelegationChainParameters -> \bs ts ai u -> MTL.runExceptT (newUpdateValidator bs ts ai u)
     bsoConstrainBakerCommission = doConstrainBakerCommission
     bsoConfigureDelegation = case delegationChainParameters @pv of
         DelegationChainParameters -> doConfigureDelegation
+    bsoAddDelegator = case delegationChainParameters @pv of
+        DelegationChainParameters -> \bs ai a -> MTL.runExceptT (newAddDelegator bs ai a)
+    bsoUpdateDelegator = case delegationChainParameters @pv of
+        DelegationChainParameters -> \bs ts ai u -> MTL.runExceptT (newUpdateDelegator bs ts ai u)
     bsoUpdateBakerKeys = doUpdateBakerKeys
     bsoUpdateBakerStake = doUpdateBakerStake
     bsoUpdateBakerRestakeEarnings = doUpdateBakerRestakeEarnings
diff --git a/concordium-consensus/src/Concordium/Scheduler.hs b/concordium-consensus/src/Concordium/Scheduler.hs
index 33e6dbddd..c77dd72b5 100644
--- a/concordium-consensus/src/Concordium/Scheduler.hs
+++ b/concordium-consensus/src/Concordium/Scheduler.hs
@@ -2020,38 +2020,28 @@ handleAddBaker wtc abElectionVerifyKey abSignatureVerifyKey abAggregationVerifyK
                     else return (TxReject InvalidProof, energyCost, usedEnergy)
 
 -- | Argument to configure baker 'withDeposit' continuation.
-data ConfigureBakerCont
-    = ConfigureAddBakerCont
-        { cbcCapital :: !Amount,
-          cbcRestakeEarnings :: !Bool,
-          cbcOpenForDelegation :: !OpenStatus,
-          cbcKeysWithProofs :: !BakerKeysWithProofs,
-          cbcMetadataURL :: !UrlText,
-          cbcTransactionFeeCommission :: !AmountFraction,
-          cbcBakingRewardCommission :: !AmountFraction,
-          cbcFinalizationRewardCommission :: !AmountFraction
+-- data ConfigureBakerCont
+--     = ConfigureAddBakerCont
+--         { cbcCapital :: !Amount,
+--           cbcRestakeEarnings :: !Bool,
+--           cbcOpenForDelegation :: !OpenStatus,
+--           cbcKeysWithProofs :: !BakerKeysWithProofs,
+--           cbcMetadataURL :: !UrlText,
+--           cbcTransactionFeeCommission :: !AmountFraction,
+--           cbcBakingRewardCommission :: !AmountFraction,
+--           cbcFinalizationRewardCommission :: !AmountFraction
+--         }
+--     | ConfigureUpdateBakerCont
+data ConfigureBakerCont (av :: AccountVersion)
+    = CBCAdd
+        { cbcRemoveDelegator :: Conditionally (SupportsFlexibleCooldown av) Bool,
+          cbcValidatorAdd :: BI.ValidatorAdd,
+          cbcProofsValid :: Bool
         }
-    | ConfigureUpdateBakerCont
-
--- \| SwitchToBakerCont
---     { stbcCapital :: !(Maybe Amount),
---       stbcRestakeEarnings :: !(Maybe Bool),
---       stbcOpenForDelegation :: !OpenStatus,
---       stbcKeysWithProofs :: !BakerKeysWithProofs,
---       stbcMetadataURL :: !UrlText,
---       stbcTransactionFeeCommission :: !AmountFraction,
---       stbcBakingRewardCommission :: !AmountFraction,
---       stbcFinalizationRewardCommission :: !AmountFraction
---     }
-
--- | Argument to configure delegation 'withDeposit' continuation.
-data ConfigureDelegationCont
-    = ConfigureAddDelegationCont
-        { cdcCapital :: !Amount,
-          cdcRestakeEarnings :: !Bool,
-          cdcDelegationTarget :: !DelegationTarget
+    | CBCUpdate
+        { cbcValidatorUpdate :: BI.ValidatorUpdate,
+          cbcProofsValid :: Bool
         }
-    | ConfigureUpdateDelegationCont
 
 handleConfigureBaker ::
     forall m.
@@ -2090,51 +2080,54 @@ handleConfigureBaker
       where
         senderAccount = wtc ^. wtcSenderAccount
         senderAddress = wtc ^. wtcSenderAddress
-        configureAddBakerArg =
-            case ( cbCapital,
-                   cbRestakeEarnings,
-                   cbOpenForDelegation,
-                   cbKeysWithProofs,
-                   cbMetadataURL,
-                   cbTransactionFeeCommission,
-                   cbBakingRewardCommission,
-                   cbFinalizationRewardCommission
-                 ) of
-                ( Just cbcCapital,
-                  Just cbcRestakeEarnings,
-                  Just cbcOpenForDelegation,
-                  Just cbcKeysWithProofs,
-                  Just cbcMetadataURL,
-                  Just cbcTransactionFeeCommission,
-                  Just cbcBakingRewardCommission,
-                  Just cbcFinalizationRewardCommission
-                    ) ->
-                        return ConfigureAddBakerCont{..}
-                _ ->
-                    rejectTransaction MissingBakerAddParameters
-        switchToBakerArg :: Amount -> Bool -> LocalT (ConfigureBakerCont, Amount) m ConfigureBakerCont
-        switchToBakerArg amt restake =
-            let cbcCapital = fromMaybe amt cbCapital
-                cbcRestakeEarnings = fromMaybe restake cbRestakeEarnings
-            in  case ( cbOpenForDelegation,
-                       cbKeysWithProofs,
-                       cbMetadataURL,
-                       cbTransactionFeeCommission,
-                       cbBakingRewardCommission,
-                       cbFinalizationRewardCommission
-                     ) of
-                    ( Just cbcOpenForDelegation,
-                      Just cbcKeysWithProofs,
-                      Just cbcMetadataURL,
-                      Just cbcTransactionFeeCommission,
-                      Just cbcBakingRewardCommission,
-                      Just cbcFinalizationRewardCommission
-                        ) ->
-                            return ConfigureAddBakerCont{..}
-                    _ ->
-                        rejectTransaction MissingBakerAddParameters
-        configureUpdateBakerArg =
-            return ConfigureUpdateBakerCont
+        flexibleCooldown = sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor (MPV m)))
+        mCBCAdd :: Amount -> Bool -> Maybe (ConfigureBakerCont (AccountVersionFor (MPV m)))
+        mCBCAdd vaCapital vaRestakeEarnings = do
+            keysWithProofs <- cbKeysWithProofs
+            let vaKeys = BI.bakerKeysWithoutProofs keysWithProofs
+            _transactionCommission <- cbTransactionFeeCommission
+            _bakingCommission <- cbBakingRewardCommission
+            _finalizationCommission <- cbFinalizationRewardCommission
+            let vaCommissionRates = CommissionRates{..}
+            vaOpenForDelegation <- cbOpenForDelegation
+            vaMetadataURL <- cbMetadataURL
+            return
+                CBCAdd
+                    { cbcRemoveDelegator = conditionally flexibleCooldown False,
+                      cbcValidatorAdd = BI.ValidatorAdd{..},
+                      cbcProofsValid = areKeysOK keysWithProofs
+                    }
+        makeArg = do
+            accountStake <- getAccountStake (snd senderAccount)
+            case accountStake of
+                AccountStakeNone -> do
+                    case join $ mCBCAdd <$> cbCapital <*> cbRestakeEarnings of
+                        Just va -> return va
+                        _ -> rejectTransaction MissingBakerAddParameters
+                AccountStakeDelegate del -> case flexibleCooldown of
+                    SFalse -> rejectTransaction AlreadyADelegator
+                    STrue -> do
+                        let capital = fromMaybe (_delegationStakedAmount del) cbCapital
+                        let restake = fromMaybe (_delegationStakeEarnings del) cbRestakeEarnings
+                        case mCBCAdd capital restake of
+                            Just va -> return va
+                            _ -> rejectTransaction MissingBakerAddParameters
+                AccountStakeBaker _ -> do
+                    return
+                        CBCUpdate
+                            { cbcValidatorUpdate =
+                                BI.ValidatorUpdate
+                                    { vuKeys = BI.bakerKeysWithoutProofs <$> cbKeysWithProofs,
+                                      vuCapital = cbCapital,
+                                      vuRestakeEarnings = cbRestakeEarnings,
+                                      vuMetadataURL = cbMetadataURL,
+                                      vuTransactionFeeCommission = cbTransactionFeeCommission,
+                                      vuBakingRewardCommission = cbBakingRewardCommission,
+                                      vuFinalizationRewardCommission = cbFinalizationRewardCommission,
+                                      vuOpenForDelegation = cbOpenForDelegation
+                                    },
+                              cbcProofsValid = maybe True areKeysOK cbKeysWithProofs
+                            }
         areKeysOK BakerKeysWithProofs{..} =
             let challenge = configureBakerKeyChallenge senderAddress bkwpElectionVerifyKey bkwpSignatureVerifyKey bkwpAggregationVerifyKey
                 electionP = checkElectionKeyProof challenge bkwpElectionVerifyKey bkwpProofElection
@@ -2146,46 +2139,23 @@ handleConfigureBaker
             if isJust cbKeysWithProofs
                 then tickEnergy Cost.configureBakerCostWithKeys
                 else tickEnergy Cost.configureBakerCostWithoutKeys
-            accountStake <- getAccountStake (snd senderAccount)
-            arg <- case accountStake of
-                AccountStakeNone -> configureAddBakerArg
-                AccountStakeDelegate del -> case sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor (MPV m))) of
-                    SFalse -> rejectTransaction AlreadyADelegator
-                    STrue -> switchToBakerArg (_delegationStakedAmount del) (_delegationStakeEarnings del)
-                AccountStakeBaker _ ->
-                    configureUpdateBakerArg
+            arg <- makeArg
             (arg,) <$> getCurrentAccountTotalAmount senderAccount
         chargeAndExecute ls argAndBalance = do
             (usedEnergy, energyCost) <- computeExecutionCharge (wtc ^. wtcEnergyAmount) (ls ^. energyLeft)
             chargeExecutionCost senderAccount energyCost
             executeConfigure energyCost usedEnergy argAndBalance
-        executeConfigure energyCost usedEnergy (ConfigureAddBakerCont{..}, accountBalance) = do
-            if accountBalance < cbcCapital
+        executeConfigure energyCost usedEnergy (CBCAdd{..}, accountBalance) = do
+            if accountBalance < BI.vaCapital cbcValidatorAdd
                 then -- The balance is insufficient.
                     return (TxReject InsufficientBalanceForBakerStake, energyCost, usedEnergy)
                 else
-                    if areKeysOK cbcKeysWithProofs
+                    if cbcProofsValid
                         then do
-                            let bca =
-                                    BI.BakerConfigureAdd
-                                        { bcaKeys =
-                                            BI.BakerKeyUpdate
-                                                { bkuSignKey = bkwpSignatureVerifyKey cbcKeysWithProofs,
-                                                  bkuAggregationKey = bkwpAggregationVerifyKey cbcKeysWithProofs,
-                                                  bkuElectionKey = bkwpElectionVerifyKey cbcKeysWithProofs
-                                                },
-                                          bcaCapital = cbcCapital,
-                                          bcaRestakeEarnings = cbcRestakeEarnings,
-                                          bcaOpenForDelegation = cbcOpenForDelegation,
-                                          bcaMetadataURL = cbcMetadataURL,
-                                          bcaTransactionFeeCommission = cbcTransactionFeeCommission,
-                                          bcaBakingRewardCommission = cbcBakingRewardCommission,
-                                          bcaFinalizationRewardCommission = cbcFinalizationRewardCommission
-                                        }
-                            res <- configureBaker (fst senderAccount) bca
+                            res <- addValidator (fst senderAccount) cbcValidatorAdd
                             kResult energyCost usedEnergy bca res
                         else return (TxReject InvalidProof, energyCost, usedEnergy)
-        executeConfigure energyCost usedEnergy (ConfigureUpdateBakerCont, accountBalance) = do
+        executeConfigure energyCost usedEnergy (CBCUpdate{..}, accountBalance) = do
             if maybe False (accountBalance <) cbCapital
                 then return (TxReject InsufficientBalanceForBakerStake, energyCost, usedEnergy)
                 else
@@ -2281,6 +2251,15 @@ handleConfigureBaker
         kResult energyCost usedEnergy _ BI.BCInvalidBaker =
             return (TxReject (NotABaker senderAddress), energyCost, usedEnergy)
 
+-- | Argument to configure delegation 'withDeposit' continuation.
+data ConfigureDelegationCont
+    = ConfigureAddDelegationCont
+        { cdcCapital :: !Amount,
+          cdcRestakeEarnings :: !Bool,
+          cdcDelegationTarget :: !DelegationTarget
+        }
+    | ConfigureUpdateDelegationCont
+
 handleConfigureDelegation ::
     (PVSupportsDelegation (MPV m), SchedulerMonad m) =>
     WithDepositContext m ->
diff --git a/concordium-consensus/src/Concordium/Scheduler/Environment.hs b/concordium-consensus/src/Concordium/Scheduler/Environment.hs
index b5894ed35..ead45d517 100644
--- a/concordium-consensus/src/Concordium/Scheduler/Environment.hs
+++ b/concordium-consensus/src/Concordium/Scheduler/Environment.hs
@@ -192,23 +192,65 @@ class
         BakerAdd ->
         m BakerAddResult
 
-    -- | From chain parameters version >= 1, this operation is used to add/remove/update a baker.
+    -- | From chain parameters version 1, this operation adds a validator on an account.
     --  For details of the behaviour and return values, see
-    --  'Concordium.GlobalState.BlockState.bsoConfigureBaker'.
-    configureBaker ::
+    --  'Concordium.GlobalState.BlockState.bsoAddValidator'.
+    --
+    --  PRECONDITION:
+    --   * The account must exist;
+    --   * The account must not already be a validator;
+    --   * The account must not be a delegator;
+    --   * The account must have sufficient balance to cover the stake.
+    addValidator ::
+        (PVSupportsDelegation (MPV m)) =>
+        AccountIndex ->
+        ValidatorAdd ->
+        m (Either ValidatorConfigureFailure ())
+
+    -- | From chain parameters version 1, this operation updates or removes a validator on an
+    --  account. For details of the behaviour and return values, see
+    --  'Concordium.GlobalState.BlockState.bsoUpdateValidator'.
+    --
+    -- PRECONDITION:
+    --  * The account must exist;
+    --  * The account must be a validator;
+    --  * The account must have sufficient balance to cover the new stake.
+    updateValidator ::
         (PVSupportsDelegation (MPV m)) =>
+        Timestamp ->
         AccountIndex ->
-        BakerConfigure ->
-        m BakerConfigureResult
+        ValidatorUpdate ->
+        m (Either ValidatorConfigureFailure [BakerConfigureUpdateChange])
 
-    -- | From chain parameters version >= 1, this operation is used to add/remove/update a delegator.
+    -- | From chain parameters version 1, this operation adds a delegator on an account.
     --  For details of the behaviour and return values, see
-    --  'Concordium.GlobalState.BlockState.bsoConfigureDelegation'.
-    configureDelegation ::
+    --  'Concordium.GlobalState.BlockState.bsoAddDelegator'.
+    --
+    --  PRECONDITION:
+    --   * The account must exist;
+    --   * The account must not already be a delegator;
+    --   * The account must not be a validator;
+    --   * The account must have sufficient balance to cover the stake.
+    addDelegator ::
+        (PVSupportsDelegation (MPV m)) =>
+        AccountIndex ->
+        DelegatorAdd ->
+        m (Either DelegatorConfigureFailure ())
+
+    -- | From chain parameters version 1, this operation updates or removes a delegator on an
+    --  account. For details of the behaviour and return values, see
+    -- 'Concordium.GlobalState.BlockState.bsoUpdateDelegator'.
+    --
+    -- PRECONDITION:
+    --  * The account must exist;
+    --  * The account must be a delegator;
+    --  * The account must have sufficient balance to cover the new stake.
+    updateDelegator ::
         (PVSupportsDelegation (MPV m)) =>
+        Timestamp ->
         AccountIndex ->
-        DelegationConfigure ->
-        m DelegationConfigureResult
+        DelegatorUpdate ->
+        m (Either DelegatorConfigureFailure [DelegationConfigureUpdateChange])
 
     -- | Remove the baker associated with an account.
     --  The removal takes effect after a cooling-off period.
diff --git a/concordium-consensus/src/Concordium/Scheduler/EnvironmentImplementation.hs b/concordium-consensus/src/Concordium/Scheduler/EnvironmentImplementation.hs
index c2502b838..dff293b49 100644
--- a/concordium-consensus/src/Concordium/Scheduler/EnvironmentImplementation.hs
+++ b/concordium-consensus/src/Concordium/Scheduler/EnvironmentImplementation.hs
@@ -293,19 +293,41 @@ instance
         ssBlockState .= s'
         return ret
 
-    {-# INLINE configureBaker #-}
-    configureBaker ai bconfig = do
+    {-# INLINE addValidator #-}
+    addValidator ai vadd = do
         s <- use ssBlockState
-        (ret, s') <- lift (BS.bsoConfigureBaker s ai bconfig)
-        ssBlockState .= s'
-        return ret
-
-    {-# INLINE configureDelegation #-}
-    configureDelegation ai dconfig = do
+        lift (BS.bsoAddValidator s ai vadd) >>= \case
+            Left e -> return (Left e)
+            Right s' -> do
+                ssBlockState .= s'
+                return (Right ())
+
+    {-# INLINE updateValidator #-}
+    updateValidator ts ai vadd = do
         s <- use ssBlockState
-        (ret, s') <- lift (BS.bsoConfigureDelegation s ai dconfig)
-        ssBlockState .= s'
-        return ret
+        lift (BS.bsoUpdateValidator s ts ai vadd) >>= \case
+            Left e -> return (Left e)
+            Right (events, s') -> do
+                ssBlockState .= s'
+                return (Right events)
+
+    {-# INLINE addDelegator #-}
+    addDelegator ai dadd = do
+        s <- use ssBlockState
+        lift (BS.bsoAddDelegator s ai dadd) >>= \case
+            Left e -> return (Left e)
+            Right s' -> do
+                ssBlockState .= s'
+                return (Right ())
+
+    {-# INLINE updateDelegator #-}
+    updateDelegator ts ai dadd = do
+        s <- use ssBlockState
+        lift (BS.bsoUpdateDelegator s ts ai dadd) >>= \case
+            Left e -> return (Left e)
+            Right (events, s') -> do
+                ssBlockState .= s'
+                return (Right events)
 
     {-# INLINE removeBaker #-}
     removeBaker ai = do

From c59d5f0c7fd8b3bbc5ba507bebcdcef051a5700b Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Thu, 25 Jul 2024 15:58:14 +0200
Subject: [PATCH 37/81] Scheduler handling for configure baker and delegator.

---
 .../src/Concordium/GlobalState/BakerInfo.hs   |  23 +
 .../Persistent/Account/StructureV1.hs         |   3 +-
 .../src/Concordium/Scheduler.hs               | 448 +++++++++---------
 3 files changed, 241 insertions(+), 233 deletions(-)

diff --git a/concordium-consensus/src/Concordium/GlobalState/BakerInfo.hs b/concordium-consensus/src/Concordium/GlobalState/BakerInfo.hs
index 43732db53..aebfe102c 100644
--- a/concordium-consensus/src/Concordium/GlobalState/BakerInfo.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/BakerInfo.hs
@@ -222,6 +222,20 @@ data ValidatorUpdate = ValidatorUpdate
     }
     deriving (Eq, Show)
 
+-- | A 'ValidatorUpdate' that removes the validator.
+validatorRemove :: ValidatorUpdate
+validatorRemove =
+    ValidatorUpdate
+        { vuKeys = Nothing,
+          vuCapital = Just 0,
+          vuRestakeEarnings = Nothing,
+          vuOpenForDelegation = Nothing,
+          vuMetadataURL = Nothing,
+          vuTransactionFeeCommission = Nothing,
+          vuBakingRewardCommission = Nothing,
+          vuFinalizationRewardCommission = Nothing
+        }
+
 -- | Failure modes when configuring a validator.
 data ValidatorConfigureFailure
     = -- | The stake is below the required threshold dictated by current chain parameters.
@@ -335,6 +349,15 @@ data DelegatorUpdate = DelegatorUpdate
     }
     deriving (Eq, Show)
 
+-- | A 'DelegatorUpdate' that removes the delegator.
+delegatorRemove :: DelegatorUpdate
+delegatorRemove =
+    DelegatorUpdate
+        { duCapital = Just 0,
+          duRestakeEarnings = Nothing,
+          duDelegationTarget = Nothing
+        }
+
 -- | Data structure used to add/remove/update delegator.
 data DelegationConfigure
     = -- | Add a delegator, all fields are required.
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
index 80b6ea9bc..bdacd182a 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
@@ -34,7 +34,6 @@ import Concordium.Types.Accounts
 import Concordium.Types.Accounts.Releases
 import Concordium.Types.Execution
 import Concordium.Types.HashableTo
-import Concordium.Types.Option
 import Concordium.Types.Parameters
 import Concordium.Utils
 
@@ -44,7 +43,7 @@ import qualified Concordium.GlobalState.Basic.BlockState.Account as Transient
 import qualified Concordium.GlobalState.Basic.BlockState.AccountReleaseSchedule as TARS
 import qualified Concordium.GlobalState.Basic.BlockState.AccountReleaseScheduleV1 as TARSV1
 import Concordium.GlobalState.BlockState (AccountAllowance (..))
-import Concordium.GlobalState.CooldownQueue (Cooldowns (..), emptyCooldowns)
+import Concordium.GlobalState.CooldownQueue (Cooldowns (..))
 import Concordium.GlobalState.Persistent.Account.CooldownQueue as CooldownQueue
 import Concordium.GlobalState.Persistent.Account.EncryptedAmount
 import Concordium.GlobalState.Persistent.Account.MigrationStateInterface
diff --git a/concordium-consensus/src/Concordium/Scheduler.hs b/concordium-consensus/src/Concordium/Scheduler.hs
index c77dd72b5..b448fcf28 100644
--- a/concordium-consensus/src/Concordium/Scheduler.hs
+++ b/concordium-consensus/src/Concordium/Scheduler.hs
@@ -2020,29 +2020,27 @@ handleAddBaker wtc abElectionVerifyKey abSignatureVerifyKey abAggregationVerifyK
                     else return (TxReject InvalidProof, energyCost, usedEnergy)
 
 -- | Argument to configure baker 'withDeposit' continuation.
--- data ConfigureBakerCont
---     = ConfigureAddBakerCont
---         { cbcCapital :: !Amount,
---           cbcRestakeEarnings :: !Bool,
---           cbcOpenForDelegation :: !OpenStatus,
---           cbcKeysWithProofs :: !BakerKeysWithProofs,
---           cbcMetadataURL :: !UrlText,
---           cbcTransactionFeeCommission :: !AmountFraction,
---           cbcBakingRewardCommission :: !AmountFraction,
---           cbcFinalizationRewardCommission :: !AmountFraction
---         }
---     | ConfigureUpdateBakerCont
 data ConfigureBakerCont (av :: AccountVersion)
     = CBCAdd
         { cbcRemoveDelegator :: Conditionally (SupportsFlexibleCooldown av) Bool,
-          cbcValidatorAdd :: BI.ValidatorAdd,
-          cbcProofsValid :: Bool
+          cbcValidatorAdd :: BI.ValidatorAdd
         }
     | CBCUpdate
-        { cbcValidatorUpdate :: BI.ValidatorUpdate,
-          cbcProofsValid :: Bool
+        { cbcValidatorUpdate :: BI.ValidatorUpdate
         }
 
+-- | Check that the ownership proofs for keys used for a configure baker transaction are valid.
+checkConfigureBakerKeys :: AccountAddress -> BakerKeysWithProofs -> Bool
+checkConfigureBakerKeys senderAddress BakerKeysWithProofs{..} =
+    electionP && signP && aggregationP
+  where
+    challenge = configureBakerKeyChallenge senderAddress bkwpElectionVerifyKey bkwpSignatureVerifyKey bkwpAggregationVerifyKey
+    electionP = checkElectionKeyProof challenge bkwpElectionVerifyKey bkwpProofElection
+    signP = checkSignatureVerifyKeyProof challenge bkwpSignatureVerifyKey bkwpProofSig
+    aggregationP = Bls.checkProofOfKnowledgeSK challenge bkwpProofAggregation bkwpAggregationVerifyKey
+
+-- makeConfigureBakerArg
+
 handleConfigureBaker ::
     forall m.
     ( PVSupportsDelegation (MPV m),
@@ -2079,12 +2077,17 @@ handleConfigureBaker
         withDeposit wtc tickGetArgAndBalance chargeAndExecute
       where
         senderAccount = wtc ^. wtcSenderAccount
+        senderAccountIndex = fst senderAccount
+        bid = BakerId senderAccountIndex
         senderAddress = wtc ^. wtcSenderAddress
         flexibleCooldown = sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor (MPV m)))
-        mCBCAdd :: Amount -> Bool -> Maybe (ConfigureBakerCont (AccountVersionFor (MPV m)))
-        mCBCAdd vaCapital vaRestakeEarnings = do
-            keysWithProofs <- cbKeysWithProofs
-            let vaKeys = BI.bakerKeysWithoutProofs keysWithProofs
+        mCBCAdd ::
+            Conditionally (SupportsFlexibleCooldown (AccountVersionFor (MPV m))) Bool ->
+            Amount ->
+            Bool ->
+            Maybe (ConfigureBakerCont (AccountVersionFor (MPV m)))
+        mCBCAdd removeDelegator vaCapital vaRestakeEarnings = do
+            vaKeys <- BI.bakerKeysWithoutProofs <$> cbKeysWithProofs
             _transactionCommission <- cbTransactionFeeCommission
             _bakingCommission <- cbBakingRewardCommission
             _finalizationCommission <- cbFinalizationRewardCommission
@@ -2093,15 +2096,15 @@ handleConfigureBaker
             vaMetadataURL <- cbMetadataURL
             return
                 CBCAdd
-                    { cbcRemoveDelegator = conditionally flexibleCooldown False,
-                      cbcValidatorAdd = BI.ValidatorAdd{..},
-                      cbcProofsValid = areKeysOK keysWithProofs
+                    { cbcRemoveDelegator = removeDelegator,
+                      cbcValidatorAdd = BI.ValidatorAdd{..}
                     }
         makeArg = do
             accountStake <- getAccountStake (snd senderAccount)
             case accountStake of
                 AccountStakeNone -> do
-                    case join $ mCBCAdd <$> cbCapital <*> cbRestakeEarnings of
+                    let removeDelegator = conditionally flexibleCooldown False
+                    case join $ mCBCAdd removeDelegator <$> cbCapital <*> cbRestakeEarnings of
                         Just va -> return va
                         _ -> rejectTransaction MissingBakerAddParameters
                 AccountStakeDelegate del -> case flexibleCooldown of
@@ -2109,7 +2112,7 @@ handleConfigureBaker
                     STrue -> do
                         let capital = fromMaybe (_delegationStakedAmount del) cbCapital
                         let restake = fromMaybe (_delegationStakeEarnings del) cbRestakeEarnings
-                        case mCBCAdd capital restake of
+                        case mCBCAdd (CTrue True) capital restake of
                             Just va -> return va
                             _ -> rejectTransaction MissingBakerAddParameters
                 AccountStakeBaker _ -> do
@@ -2125,15 +2128,8 @@ handleConfigureBaker
                                       vuBakingRewardCommission = cbBakingRewardCommission,
                                       vuFinalizationRewardCommission = cbFinalizationRewardCommission,
                                       vuOpenForDelegation = cbOpenForDelegation
-                                    },
-                              cbcProofsValid = maybe True areKeysOK cbKeysWithProofs
+                                    }
                             }
-        areKeysOK BakerKeysWithProofs{..} =
-            let challenge = configureBakerKeyChallenge senderAddress bkwpElectionVerifyKey bkwpSignatureVerifyKey bkwpAggregationVerifyKey
-                electionP = checkElectionKeyProof challenge bkwpElectionVerifyKey bkwpProofElection
-                signP = checkSignatureVerifyKeyProof challenge bkwpSignatureVerifyKey bkwpProofSig
-                aggregationP = Bls.checkProofOfKnowledgeSK challenge bkwpProofAggregation bkwpAggregationVerifyKey
-            in  electionP && signP && aggregationP
         tickGetArgAndBalance = do
             -- Charge the energy cost before checking the validity of the parameters.
             if isJust cbKeysWithProofs
@@ -2144,123 +2140,109 @@ handleConfigureBaker
         chargeAndExecute ls argAndBalance = do
             (usedEnergy, energyCost) <- computeExecutionCharge (wtc ^. wtcEnergyAmount) (ls ^. energyLeft)
             chargeExecutionCost senderAccount energyCost
-            executeConfigure energyCost usedEnergy argAndBalance
-        executeConfigure energyCost usedEnergy (CBCAdd{..}, accountBalance) = do
-            if accountBalance < BI.vaCapital cbcValidatorAdd
-                then -- The balance is insufficient.
-                    return (TxReject InsufficientBalanceForBakerStake, energyCost, usedEnergy)
-                else
-                    if cbcProofsValid
-                        then do
-                            res <- addValidator (fst senderAccount) cbcValidatorAdd
-                            kResult energyCost usedEnergy bca res
-                        else return (TxReject InvalidProof, energyCost, usedEnergy)
-        executeConfigure energyCost usedEnergy (CBCUpdate{..}, accountBalance) = do
-            if maybe False (accountBalance <) cbCapital
-                then return (TxReject InsufficientBalanceForBakerStake, energyCost, usedEnergy)
-                else
-                    if maybe True areKeysOK cbKeysWithProofs
-                        then do
-                            -- The proof validates that the baker owns all the private keys,
-                            -- thus we can try to create the baker.
-                            let bku =
-                                    cbKeysWithProofs <&> \BakerKeysWithProofs{..} ->
-                                        BI.BakerKeyUpdate
-                                            { bkuSignKey = bkwpSignatureVerifyKey,
-                                              bkuAggregationKey = bkwpAggregationVerifyKey,
-                                              bkuElectionKey = bkwpElectionVerifyKey
-                                            }
-                            cm <- getChainMetadata
-                            let bcu =
-                                    BI.BakerConfigureUpdate
-                                        { bcuSlotTimestamp = slotTime cm,
-                                          bcuKeys = bku,
-                                          bcuCapital = cbCapital,
-                                          bcuRestakeEarnings = cbRestakeEarnings,
-                                          bcuOpenForDelegation = cbOpenForDelegation,
-                                          bcuMetadataURL = cbMetadataURL,
-                                          bcuTransactionFeeCommission = cbTransactionFeeCommission,
-                                          bcuBakingRewardCommission = cbBakingRewardCommission,
-                                          bcuFinalizationRewardCommission = cbFinalizationRewardCommission
-                                        }
-                            res <- configureBaker (fst senderAccount) bcu
-                            kResult energyCost usedEnergy bcu res
-                        else return (TxReject InvalidProof, energyCost, usedEnergy)
-        kResult energyCost usedEnergy BI.BakerConfigureUpdate{} (BI.BCSuccess changes bid) = do
-            let events =
-                    changes <&> \case
-                        BI.BakerConfigureStakeIncreased newStake ->
-                            BakerStakeIncreased bid senderAddress newStake
-                        BI.BakerConfigureStakeReduced newStake
-                            | newStake == 0 -> BakerRemoved bid senderAddress
-                            | otherwise -> BakerStakeDecreased bid senderAddress newStake
-                        BI.BakerConfigureRestakeEarnings newRestakeEarnings ->
-                            BakerSetRestakeEarnings bid senderAddress newRestakeEarnings
-                        BI.BakerConfigureOpenForDelegation newOpenStatus ->
-                            BakerSetOpenStatus bid senderAddress newOpenStatus
-                        BI.BakerConfigureUpdateKeys BI.BakerKeyUpdate{..} ->
-                            BakerKeysUpdated
-                                { ebkuBakerId = bid,
-                                  ebkuAccount = senderAddress,
-                                  ebkuSignKey = bkuSignKey,
-                                  ebkuElectionKey = bkuElectionKey,
-                                  ebkuAggregationKey = bkuAggregationKey
-                                }
-                        BI.BakerConfigureMetadataURL newMetadataURL ->
-                            BakerSetMetadataURL bid senderAddress newMetadataURL
-                        BI.BakerConfigureTransactionFeeCommission transactionFeeCommission ->
-                            BakerSetTransactionFeeCommission bid senderAddress transactionFeeCommission
-                        BI.BakerConfigureBakingRewardCommission bakingRewardCommission ->
-                            BakerSetBakingRewardCommission bid senderAddress bakingRewardCommission
-                        BI.BakerConfigureFinalizationRewardCommission finalizationRewardCommission ->
-                            BakerSetFinalizationRewardCommission bid senderAddress finalizationRewardCommission
-            return (TxSuccess events, energyCost, usedEnergy)
-        kResult energyCost usedEnergy BI.BakerConfigureAdd{..} (BI.BCSuccess _ bid) = do
-            let events =
-                    [ BakerAdded
-                        { ebaBakerId = bid,
-                          ebaAccount = senderAddress,
-                          ebaSignKey = BI.bkuSignKey bcaKeys,
-                          ebaElectionKey = BI.bkuElectionKey bcaKeys,
-                          ebaAggregationKey = BI.bkuAggregationKey bcaKeys,
-                          ebaStake = bcaCapital,
-                          ebaRestakeEarnings = bcaRestakeEarnings
-                        },
-                      BakerSetRestakeEarnings bid senderAddress bcaRestakeEarnings,
-                      BakerSetOpenStatus bid senderAddress bcaOpenForDelegation,
-                      BakerSetMetadataURL bid senderAddress bcaMetadataURL,
-                      BakerSetTransactionFeeCommission bid senderAddress bcaTransactionFeeCommission,
-                      BakerSetBakingRewardCommission bid senderAddress bcaBakingRewardCommission,
-                      BakerSetFinalizationRewardCommission bid senderAddress bcaFinalizationRewardCommission
-                    ]
-            return (TxSuccess events, energyCost, usedEnergy)
-        kResult energyCost usedEnergy _ BI.BCInvalidAccount =
-            return (TxReject (InvalidAccountReference senderAddress), energyCost, usedEnergy)
-        kResult energyCost usedEnergy _ (BI.BCDuplicateAggregationKey key) =
-            return (TxReject (DuplicateAggregationKey key), energyCost, usedEnergy)
-        kResult energyCost usedEnergy _ BI.BCStakeUnderThreshold =
-            return (TxReject StakeUnderMinimumThresholdForBaking, energyCost, usedEnergy)
-        kResult energyCost usedEnergy _ BI.BCTransactionFeeCommissionNotInRange =
-            return (TxReject TransactionFeeCommissionNotInRange, energyCost, usedEnergy)
-        kResult energyCost usedEnergy _ BI.BCBakingRewardCommissionNotInRange =
-            return (TxReject BakingRewardCommissionNotInRange, energyCost, usedEnergy)
-        kResult energyCost usedEnergy _ BI.BCFinalizationRewardCommissionNotInRange =
-            return (TxReject FinalizationRewardCommissionNotInRange, energyCost, usedEnergy)
-        kResult energyCost usedEnergy _ BI.BCChangePending =
-            return (TxReject BakerInCooldown, energyCost, usedEnergy)
-        kResult energyCost usedEnergy _ BI.BCInvalidBaker =
-            return (TxReject (NotABaker senderAddress), energyCost, usedEnergy)
-
--- | Argument to configure delegation 'withDeposit' continuation.
-data ConfigureDelegationCont
-    = ConfigureAddDelegationCont
-        { cdcCapital :: !Amount,
-          cdcRestakeEarnings :: !Bool,
-          cdcDelegationTarget :: !DelegationTarget
+            result <- executeConfigure argAndBalance
+            return (result, energyCost, usedEnergy)
+        proofsValid = maybe True (checkConfigureBakerKeys senderAddress) cbKeysWithProofs
+        executeConfigure (CBCAdd{..}, accountBalance)
+            | accountBalance < BI.vaCapital cbcValidatorAdd =
+                return (TxReject InsufficientBalanceForBakerStake)
+            | not proofsValid =
+                return (TxReject InvalidProof)
+            | otherwise = do
+                removedDelegator <- case cbcRemoveDelegator of
+                    CTrue True -> do
+                        -- Remove the delegator if necessary.
+                        -- We know this will succeed because:
+                        -- 1. The account is a delegator.
+                        -- 2. Flexible cooldown is enabled, meaning:
+                        --    * The account cannot have a pending change (which would cause failure)
+                        --    * Setting the capital to 0 will remove the delegator immediately,
+                        --      moving the old staked capital to pre-pre-cooldown.
+                        cm <- getChainMetadata
+                        _ <- updateDelegator (slotTime cm) senderAccountIndex BI.delegatorRemove
+                        return True
+                    _ -> return False
+                addValidator senderAccountIndex cbcValidatorAdd <&> \case
+                    Left failure -> rejectResult failure
+                    Right () -> addResult removedDelegator cbcValidatorAdd
+        executeConfigure (CBCUpdate{..}, accountBalance)
+            | Just newCapital <- cbCapital,
+              accountBalance < newCapital =
+                return (TxReject InsufficientBalanceForBakerStake)
+            | not proofsValid =
+                return (TxReject InvalidProof)
+            | otherwise = do
+                cm <- getChainMetadata
+                updateValidator (slotTime cm) senderAccountIndex cbcValidatorUpdate <&> \case
+                    Left failure -> rejectResult failure
+                    Right changes -> updateResult changes
+        addResult removedDelegator BI.ValidatorAdd{vaCommissionRates = CommissionRates{..}, ..} =
+            TxSuccess $
+                [DelegationRemoved (DelegatorId senderAccountIndex) senderAddress | removedDelegator]
+                    ++ [ BakerAdded
+                            { ebaBakerId = bid,
+                              ebaAccount = senderAddress,
+                              ebaSignKey = BI.bkuSignKey vaKeys,
+                              ebaElectionKey = BI.bkuElectionKey vaKeys,
+                              ebaAggregationKey = BI.bkuAggregationKey vaKeys,
+                              ebaStake = vaCapital,
+                              ebaRestakeEarnings = vaRestakeEarnings
+                            },
+                         BakerSetRestakeEarnings bid senderAddress vaRestakeEarnings,
+                         BakerSetOpenStatus bid senderAddress vaOpenForDelegation,
+                         BakerSetMetadataURL bid senderAddress vaMetadataURL,
+                         BakerSetTransactionFeeCommission bid senderAddress _transactionCommission,
+                         BakerSetBakingRewardCommission bid senderAddress _bakingCommission,
+                         BakerSetFinalizationRewardCommission bid senderAddress _finalizationCommission
+                       ]
+        updateResult changes =
+            TxSuccess $
+                changes <&> \case
+                    BI.BakerConfigureStakeIncreased newStake ->
+                        BakerStakeIncreased bid senderAddress newStake
+                    BI.BakerConfigureStakeReduced newStake
+                        | newStake == 0 -> BakerRemoved bid senderAddress
+                        | otherwise -> BakerStakeDecreased bid senderAddress newStake
+                    BI.BakerConfigureRestakeEarnings newRestakeEarnings ->
+                        BakerSetRestakeEarnings bid senderAddress newRestakeEarnings
+                    BI.BakerConfigureOpenForDelegation newOpenStatus ->
+                        BakerSetOpenStatus bid senderAddress newOpenStatus
+                    BI.BakerConfigureUpdateKeys BI.BakerKeyUpdate{..} ->
+                        BakerKeysUpdated
+                            { ebkuBakerId = bid,
+                              ebkuAccount = senderAddress,
+                              ebkuSignKey = bkuSignKey,
+                              ebkuElectionKey = bkuElectionKey,
+                              ebkuAggregationKey = bkuAggregationKey
+                            }
+                    BI.BakerConfigureMetadataURL newMetadataURL ->
+                        BakerSetMetadataURL bid senderAddress newMetadataURL
+                    BI.BakerConfigureTransactionFeeCommission transactionFeeCommission ->
+                        BakerSetTransactionFeeCommission bid senderAddress transactionFeeCommission
+                    BI.BakerConfigureBakingRewardCommission bakingRewardCommission ->
+                        BakerSetBakingRewardCommission bid senderAddress bakingRewardCommission
+                    BI.BakerConfigureFinalizationRewardCommission finalizationRewardCommission ->
+                        BakerSetFinalizationRewardCommission bid senderAddress finalizationRewardCommission
+        rejectResult failure =
+            TxReject $! case failure of
+                BI.VCFStakeUnderThreshold -> StakeUnderMinimumThresholdForBaking
+                BI.VCFTransactionFeeCommissionNotInRange -> TransactionFeeCommissionNotInRange
+                BI.VCFBakingRewardCommissionNotInRange -> BakingRewardCommissionNotInRange
+                BI.VCFFinalizationRewardCommissionNotInRange -> FinalizationRewardCommissionNotInRange
+                BI.VCFDuplicateAggregationKey key -> DuplicateAggregationKey key
+                BI.VCFChangePending -> BakerInCooldown
+
+data ConfigureDelegationCont (av :: AccountVersion)
+    = CDCAdd
+        { cdcRemoveValidator :: Conditionally (SupportsFlexibleCooldown av) Bool,
+          cdcDelegatorAdd :: BI.DelegatorAdd
+        }
+    | CDCUpdate
+        { cdcDelegatorUpdate :: BI.DelegatorUpdate
         }
-    | ConfigureUpdateDelegationCont
 
 handleConfigureDelegation ::
+    forall m.
     (PVSupportsDelegation (MPV m), SchedulerMonad m) =>
     WithDepositContext m ->
     Maybe Amount ->
@@ -2268,103 +2250,107 @@ handleConfigureDelegation ::
     Maybe DelegationTarget ->
     m (Maybe TransactionSummary)
 handleConfigureDelegation wtc cdCapital cdRestakeEarnings cdDelegationTarget =
-    withDeposit wtc tickAndGetAccountBalance kWithAccountBalance
+    withDeposit wtc tickAndGetAccountBalance chargeAndExecute
   where
     senderAccount = wtc ^. wtcSenderAccount
+    senderAccountIndex = fst senderAccount
+    did = DelegatorId senderAccountIndex
     senderAddress = wtc ^. wtcSenderAddress
 
-    configureAddDelegationArg =
-        case (cdCapital, cdRestakeEarnings, cdDelegationTarget) of
-            (Just cdcCapital, _, _)
-                | cdcCapital == 0 ->
-                    rejectTransaction InsufficientDelegationStake
-            (Just cdcCapital, Just cdcRestakeEarnings, Just cdcDelegationTarget) ->
-                return ConfigureAddDelegationCont{..}
-            _ ->
-                rejectTransaction MissingDelegationAddParameters
-    configureUpdateDelegationArg = return ConfigureUpdateDelegationCont
-
+    flexibleCooldown = sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor (MPV m)))
+    mDelegatorAdd = do
+        daCapital <- cdCapital
+        daRestakeEarnings <- cdRestakeEarnings
+        daDelegationTarget <- cdDelegationTarget
+        return BI.DelegatorAdd{..}
     tickAndGetAccountBalance = do
         -- Charge the energy cost and then check the validity of the parameters.
         tickEnergy Cost.configureDelegationCost
         accountStake <- getAccountStake (snd senderAccount)
-        arg <- case accountStake of
-            AccountStakeNone -> configureAddDelegationArg
-            AccountStakeBaker ab ->
-                rejectTransaction $
-                    AlreadyABaker $
+        arg :: (ConfigureDelegationCont (AccountVersionFor (MPV m))) <- case accountStake of
+            AccountStakeNone -> case mDelegatorAdd of
+                Just da -> return (CDCAdd (conditionally flexibleCooldown False) da)
+                Nothing -> rejectTransaction MissingDelegationAddParameters
+            AccountStakeBaker ab -> case flexibleCooldown of
+                SFalse ->
+                    rejectTransaction . AlreadyABaker $
                         ab ^. accountBakerInfo . bieBakerInfo . bakerIdentity
+                STrue -> case mDelegatorAdd of
+                    Just da -> return (CDCAdd (CTrue True) da)
+                    Nothing -> rejectTransaction MissingDelegationAddParameters
             AccountStakeDelegate _ ->
-                configureUpdateDelegationArg
-        (arg,) <$> getCurrentAccountTotalAmount senderAccount
-    kWithAccountBalance ls (ConfigureAddDelegationCont{..}, accountBalance) = do
-        (usedEnergy, energyCost) <- computeExecutionCharge (wtc ^. wtcEnergyAmount) (ls ^. energyLeft)
-        chargeExecutionCost senderAccount energyCost
-        if accountBalance < cdcCapital
-            then -- The balance is insufficient.
-                return (TxReject InsufficientBalanceForDelegationStake, energyCost, usedEnergy)
-            else do
-                -- The proof validates that the baker owns all the private keys,
-                -- thus we can try to create the baker.
-                let dca =
-                        BI.DelegationConfigureAdd
-                            { dcaCapital = cdcCapital,
-                              dcaRestakeEarnings = cdcRestakeEarnings,
-                              dcaDelegationTarget = cdcDelegationTarget
+                return $
+                    CDCUpdate
+                        BI.DelegatorUpdate
+                            { duCapital = cdCapital,
+                              duRestakeEarnings = cdRestakeEarnings,
+                              duDelegationTarget = cdDelegationTarget
                             }
-                res <- configureDelegation (fst senderAccount) dca
-                kResult energyCost usedEnergy dca res
-    kWithAccountBalance ls (ConfigureUpdateDelegationCont, accountBalance) = do
+        (arg,) <$> getCurrentAccountTotalAmount senderAccount
+    chargeAndExecute ls argAndBalance = do
         (usedEnergy, energyCost) <- computeExecutionCharge (wtc ^. wtcEnergyAmount) (ls ^. energyLeft)
         chargeExecutionCost senderAccount energyCost
-        if maybe False (accountBalance <) cdCapital
-            then return (TxReject InsufficientBalanceForDelegationStake, energyCost, usedEnergy)
-            else do
-                cm <- getChainMetadata
-                let dcu =
-                        BI.DelegationConfigureUpdate
-                            { dcuSlotTimestamp = slotTime cm,
-                              dcuCapital = cdCapital,
-                              dcuRestakeEarnings = cdRestakeEarnings,
-                              dcuDelegationTarget = cdDelegationTarget
-                            }
-                res <- configureDelegation (fst senderAccount) dcu
-                kResult energyCost usedEnergy dcu res
-    kResult energyCost usedEnergy BI.DelegationConfigureUpdate{} (BI.DCSuccess changes did) = do
-        let events =
-                changes <&> \case
-                    BI.DelegationConfigureStakeIncreased newStake ->
-                        DelegationStakeIncreased did senderAddress newStake
-                    BI.DelegationConfigureStakeReduced newStake
-                        | newStake == 0 -> DelegationRemoved did senderAddress
-                        | otherwise -> DelegationStakeDecreased did senderAddress newStake
-                    BI.DelegationConfigureRestakeEarnings newRestakeEarnings ->
-                        DelegationSetRestakeEarnings did senderAddress newRestakeEarnings
-                    BI.DelegationConfigureDelegationTarget newDelegationTarget ->
-                        DelegationSetDelegationTarget did senderAddress newDelegationTarget
-        return (TxSuccess events, energyCost, usedEnergy)
-    kResult energyCost usedEnergy BI.DelegationConfigureAdd{..} (BI.DCSuccess _ did) = do
-        let events =
-                [ DelegationAdded{edaDelegatorId = did, edaAccount = senderAddress},
-                  DelegationSetDelegationTarget did senderAddress dcaDelegationTarget,
-                  DelegationSetRestakeEarnings did senderAddress dcaRestakeEarnings,
-                  DelegationStakeIncreased did senderAddress dcaCapital
-                ]
-        return (TxSuccess events, energyCost, usedEnergy)
-    kResult energyCost usedEnergy _ BI.DCInvalidAccount =
-        return (TxReject (InvalidAccountReference senderAddress), energyCost, usedEnergy)
-    kResult energyCost usedEnergy _ BI.DCChangePending =
-        return (TxReject DelegatorInCooldown, energyCost, usedEnergy)
-    kResult energyCost usedEnergy _ BI.DCInvalidDelegator =
-        return (TxReject (NotADelegator senderAddress), energyCost, usedEnergy)
-    kResult energyCost usedEnergy _ (BI.DCInvalidDelegationTarget bid) =
-        return (TxReject (DelegationTargetNotABaker bid), energyCost, usedEnergy)
-    kResult energyCost usedEnergy _ BI.DCPoolStakeOverThreshold =
-        return (TxReject StakeOverMaximumThresholdForPool, energyCost, usedEnergy)
-    kResult energyCost usedEnergy _ BI.DCPoolOverDelegated =
-        return (TxReject PoolWouldBecomeOverDelegated, energyCost, usedEnergy)
-    kResult energyCost usedEnergy _ BI.DCPoolClosed =
-        return (TxReject PoolClosed, energyCost, usedEnergy)
+        result <- executeConfigure argAndBalance
+        return (result, energyCost, usedEnergy)
+    executeConfigure (CDCAdd{..}, accountBalance)
+        | accountBalance < BI.daCapital cdcDelegatorAdd =
+            return (TxReject InsufficientBalanceForDelegationStake)
+        | otherwise = do
+            removedValidator <- case cdcRemoveValidator of
+                CTrue True -> do
+                    -- Remove the validator if necessary.
+                    -- We know this will succeed because:
+                    -- 1. The account is a validator.
+                    -- 2. Flexible cooldown is enabled, meaning:
+                    --    * The account cannot have a pending change (which would cause failure)
+                    --    * Setting the capital to 0 will remove the validator immediately,
+                    --      moving the old staked capital to pre-pre-cooldown.
+                    cm <- getChainMetadata
+                    _ <- updateValidator (slotTime cm) senderAccountIndex BI.validatorRemove
+                    return True
+                _ -> return False
+            addDelegator senderAccountIndex cdcDelegatorAdd <&> \case
+                Left failure -> rejectResult failure
+                Right () -> addResult removedValidator cdcDelegatorAdd
+    executeConfigure (CDCUpdate{..}, accountBalance)
+        | Just newCapital <- cdCapital,
+          accountBalance < newCapital =
+            return (TxReject InsufficientBalanceForDelegationStake)
+        | otherwise = do
+            cm <- getChainMetadata
+            updateDelegator (slotTime cm) senderAccountIndex cdcDelegatorUpdate <&> \case
+                Left failure -> rejectResult failure
+                Right changes -> updateResult changes
+
+    addResult removedValidator BI.DelegatorAdd{..} =
+        TxSuccess $
+            [BakerRemoved (BakerId senderAccountIndex) senderAddress | removedValidator]
+                ++ [ DelegationAdded
+                        { edaDelegatorId = did,
+                          edaAccount = senderAddress
+                        },
+                     DelegationSetDelegationTarget did senderAddress daDelegationTarget,
+                     DelegationSetRestakeEarnings did senderAddress daRestakeEarnings,
+                     DelegationStakeIncreased did senderAddress daCapital
+                   ]
+    updateResult changes =
+        TxSuccess $
+            changes <&> \case
+                BI.DelegationConfigureStakeIncreased newStake ->
+                    DelegationStakeIncreased did senderAddress newStake
+                BI.DelegationConfigureStakeReduced newStake
+                    | newStake == 0 -> DelegationRemoved did senderAddress
+                    | otherwise -> DelegationStakeDecreased did senderAddress newStake
+                BI.DelegationConfigureRestakeEarnings newRestakeEarnings ->
+                    DelegationSetRestakeEarnings did senderAddress newRestakeEarnings
+                BI.DelegationConfigureDelegationTarget newDelegationTarget ->
+                    DelegationSetDelegationTarget did senderAddress newDelegationTarget
+    rejectResult = \case
+        BI.DCFChangePending -> TxReject DelegatorInCooldown
+        BI.DCFInvalidDelegationTarget bid -> TxReject (DelegationTargetNotABaker bid)
+        BI.DCFPoolStakeOverThreshold -> TxReject StakeOverMaximumThresholdForPool
+        BI.DCFPoolOverDelegated -> TxReject PoolWouldBecomeOverDelegated
+        BI.DCFPoolClosed -> TxReject PoolClosed
 
 -- | Remove the baker for an account. The logic is as follows:
 --

From 442ef3c9485b5957640b6229a461784039f44ccb Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Thu, 25 Jul 2024 16:49:32 +0200
Subject: [PATCH 38/81] Tests and fixes.

---
 .../src/Concordium/Scheduler.hs               | 24 +++++++++++++------
 .../GlobalStateTests/EnduringDataFlags.hs     |  2 +-
 .../scheduler/SchedulerTests/Delegation.hs    | 15 ++++++++++--
 3 files changed, 31 insertions(+), 10 deletions(-)

diff --git a/concordium-consensus/src/Concordium/Scheduler.hs b/concordium-consensus/src/Concordium/Scheduler.hs
index b448fcf28..65f3a3d0e 100644
--- a/concordium-consensus/src/Concordium/Scheduler.hs
+++ b/concordium-consensus/src/Concordium/Scheduler.hs
@@ -2106,15 +2106,18 @@ handleConfigureBaker
                     let removeDelegator = conditionally flexibleCooldown False
                     case join $ mCBCAdd removeDelegator <$> cbCapital <*> cbRestakeEarnings of
                         Just va -> return va
-                        _ -> rejectTransaction MissingBakerAddParameters
+                        Nothing -> rejectTransaction MissingBakerAddParameters
                 AccountStakeDelegate del -> case flexibleCooldown of
                     SFalse -> rejectTransaction AlreadyADelegator
                     STrue -> do
+                        -- Where flexible cooldown is supported, we can transition from a
+                        -- delegator to a validator. If the stake amount or restake earnings
+                        -- flags are not specified, we inherit them from the delegator.
                         let capital = fromMaybe (_delegationStakedAmount del) cbCapital
                         let restake = fromMaybe (_delegationStakeEarnings del) cbRestakeEarnings
                         case mCBCAdd (CTrue True) capital restake of
                             Just va -> return va
-                            _ -> rejectTransaction MissingBakerAddParameters
+                            Nothing -> rejectTransaction MissingBakerAddParameters
                 AccountStakeBaker _ -> do
                     return
                         CBCUpdate
@@ -2258,11 +2261,6 @@ handleConfigureDelegation wtc cdCapital cdRestakeEarnings cdDelegationTarget =
     senderAddress = wtc ^. wtcSenderAddress
 
     flexibleCooldown = sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor (MPV m)))
-    mDelegatorAdd = do
-        daCapital <- cdCapital
-        daRestakeEarnings <- cdRestakeEarnings
-        daDelegationTarget <- cdDelegationTarget
-        return BI.DelegatorAdd{..}
     tickAndGetAccountBalance = do
         -- Charge the energy cost and then check the validity of the parameters.
         tickEnergy Cost.configureDelegationCost
@@ -2271,6 +2269,12 @@ handleConfigureDelegation wtc cdCapital cdRestakeEarnings cdDelegationTarget =
             AccountStakeNone -> case mDelegatorAdd of
                 Just da -> return (CDCAdd (conditionally flexibleCooldown False) da)
                 Nothing -> rejectTransaction MissingDelegationAddParameters
+              where
+                mDelegatorAdd = do
+                    daCapital <- cdCapital
+                    daRestakeEarnings <- cdRestakeEarnings
+                    daDelegationTarget <- cdDelegationTarget
+                    return BI.DelegatorAdd{..}
             AccountStakeBaker ab -> case flexibleCooldown of
                 SFalse ->
                     rejectTransaction . AlreadyABaker $
@@ -2278,6 +2282,12 @@ handleConfigureDelegation wtc cdCapital cdRestakeEarnings cdDelegationTarget =
                 STrue -> case mDelegatorAdd of
                     Just da -> return (CDCAdd (CTrue True) da)
                     Nothing -> rejectTransaction MissingDelegationAddParameters
+                  where
+                    mDelegatorAdd = do
+                        let daCapital = fromMaybe (ab ^. stakedAmount) cdCapital
+                        let daRestakeEarnings = fromMaybe (ab ^. stakeEarnings) cdRestakeEarnings
+                        daDelegationTarget <- cdDelegationTarget
+                        return BI.DelegatorAdd{..}
             AccountStakeDelegate _ ->
                 return $
                     CDCUpdate
diff --git a/concordium-consensus/tests/globalstate/GlobalStateTests/EnduringDataFlags.hs b/concordium-consensus/tests/globalstate/GlobalStateTests/EnduringDataFlags.hs
index bd81c16cf..769cc14b7 100644
--- a/concordium-consensus/tests/globalstate/GlobalStateTests/EnduringDataFlags.hs
+++ b/concordium-consensus/tests/globalstate/GlobalStateTests/EnduringDataFlags.hs
@@ -47,7 +47,7 @@ testToFromBits sav = forAll (genEnduringDataFlags sav) $ \edf ->
 -- | Test that converting bits to 'EnduringDataFlags' and back is the identity where the first
 --  conversion is well-defined.
 testFromToBits :: forall av. (IsAccountVersion av) => SAccountVersion av -> Property
-testFromToBits sav = property $ \bs -> case enduringDataFlagsFromBits @av bs of
+testFromToBits _sav = property $ \bs -> case enduringDataFlagsFromBits @av bs of
     Left _ -> property ()
     Right edf -> bs === enduringDataFlagsToBits edf
 
diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/Delegation.hs b/concordium-consensus/tests/scheduler/SchedulerTests/Delegation.hs
index 9ea5d9364..8cdfbb7f4 100644
--- a/concordium-consensus/tests/scheduler/SchedulerTests/Delegation.hs
+++ b/concordium-consensus/tests/scheduler/SchedulerTests/Delegation.hs
@@ -13,6 +13,7 @@
 --  ideal. The test should be expanded to also use the persistent state implementation.
 module SchedulerTests.Delegation (tests) where
 
+import Data.Bool.Singletons
 import Lens.Micro.Platform
 
 import qualified Concordium.Crypto.SignatureScheme as SigScheme
@@ -338,7 +339,9 @@ testCase4 _ pvString =
         Helpers.assertBlockStateInvariantsH blockState (Helpers.srExecutionCosts result)
 
 -- | Test changing the target and decreasing stake such that the new stake is acceptable for the new target.
---  This still fails because the change of target is only effected after the cooldown period.
+--  This still fails before P7 because the change of stake is only effective after the cooldown period,
+--  so changing the target results in overdelegation to the new target. From P7, the stake is
+--  reduced immediately, so the transaction should succeed.
 testCase5 ::
     forall pv.
     (IsProtocolVersion pv, PVSupportsDelegation pv) =>
@@ -365,7 +368,15 @@ testCase5 _ pvString =
                 (initialBlockState @pv)
                 (Helpers.checkReloadCheck checkState)
                 transactions
-        Helpers.assertRejectWithReason StakeOverMaximumThresholdForPool result
+        () <- case sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv)) of
+            SFalse ->
+                Helpers.assertRejectWithReason StakeOverMaximumThresholdForPool result
+            STrue ->
+                Helpers.assertSuccessWithEvents
+                    [ DelegationSetDelegationTarget 1 delegator1Address (DelegateToBaker 2),
+                      DelegationStakeDecreased 1 delegator1Address 1
+                    ]
+                    result
         doBlockStateAssertions
   where
     checkState ::

From 861ccccbc49a6723fb14da6b9c9950b4fc5c1967 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Fri, 26 Jul 2024 12:23:35 +0200
Subject: [PATCH 39/81] Remove bsoConfigureBaker, bsoConfigureDelegation.
 Update tests.

---
 .../src/Concordium/GlobalState/BakerInfo.hs   | 108 +--
 .../src/Concordium/GlobalState/BlockState.hs  | 357 ++++---
 .../Persistent/Account/StructureV1.hs         |   6 +-
 .../GlobalState/Persistent/BlockState.hs      | 891 +-----------------
 .../globalstate/GlobalStateTests/Updates.hs   | 131 +--
 5 files changed, 265 insertions(+), 1228 deletions(-)

diff --git a/concordium-consensus/src/Concordium/GlobalState/BakerInfo.hs b/concordium-consensus/src/Concordium/GlobalState/BakerInfo.hs
index aebfe102c..0aa043934 100644
--- a/concordium-consensus/src/Concordium/GlobalState/BakerInfo.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/BakerInfo.hs
@@ -183,6 +183,16 @@ data BakerAddResult
       BAStakeUnderThreshold
     deriving (Eq, Ord, Show)
 
+-- | Result of remove baker.
+data BakerRemoveResult
+    = -- | The baker was removed, effective from the given epoch.
+      BRRemoved !BakerId !Epoch
+    | -- | This is not a valid baker.
+      BRInvalidBaker
+    | -- | A change is already pending on this baker.
+      BRChangePending !BakerId
+    deriving (Eq, Ord, Show)
+
 -- | Parameters for adding a validator.
 data ValidatorAdd = ValidatorAdd
     { -- | The keys for the validator.
@@ -252,34 +262,6 @@ data ValidatorConfigureFailure
       VCFChangePending
     deriving (Eq, Show)
 
--- | Data structure used to add/remove/update baker.
-data BakerConfigure
-    = -- | Add a baker, all fields are required.
-      BakerConfigureAdd
-        { bcaKeys :: !BakerKeyUpdate,
-          bcaCapital :: !Amount,
-          bcaRestakeEarnings :: !Bool,
-          bcaOpenForDelegation :: !OpenStatus,
-          bcaMetadataURL :: !UrlText,
-          bcaTransactionFeeCommission :: !AmountFraction,
-          bcaBakingRewardCommission :: !AmountFraction,
-          bcaFinalizationRewardCommission :: !AmountFraction
-        }
-    | -- | Update baker with optional fields.
-      BakerConfigureUpdate
-        { -- | The timestamp of the current slot (slot time).
-          bcuSlotTimestamp :: !Timestamp,
-          bcuKeys :: !(Maybe BakerKeyUpdate),
-          bcuCapital :: !(Maybe Amount),
-          bcuRestakeEarnings :: !(Maybe Bool),
-          bcuOpenForDelegation :: !(Maybe OpenStatus),
-          bcuMetadataURL :: !(Maybe UrlText),
-          bcuTransactionFeeCommission :: !(Maybe AmountFraction),
-          bcuBakingRewardCommission :: !(Maybe AmountFraction),
-          bcuFinalizationRewardCommission :: !(Maybe AmountFraction)
-        }
-    deriving (Eq, Show)
-
 -- | A baker update change result from configure baker. Used to indicate whether the configure will cause
 --  any changes to the baker's stake, keys, etc.
 data BakerConfigureUpdateChange
@@ -294,38 +276,6 @@ data BakerConfigureUpdateChange
     | BakerConfigureFinalizationRewardCommission !AmountFraction
     deriving (Eq, Show)
 
--- | Result of configure baker.
-data BakerConfigureResult
-    = -- | Configure baker successful.
-      BCSuccess ![BakerConfigureUpdateChange] !BakerId
-    | -- | Account unknown.
-      BCInvalidAccount
-    | -- | The aggregation key already exists.
-      BCDuplicateAggregationKey !BakerAggregationVerifyKey
-    | -- | The stake is below the required threshold dictated by current chain parameters.
-      BCStakeUnderThreshold
-    | -- | The finalization reward commission is not in the allowed range.
-      BCFinalizationRewardCommissionNotInRange
-    | -- | The baking reward commission is not in the allowed range.
-      BCBakingRewardCommissionNotInRange
-    | -- | The transaction fee commission is not in the allowed range.
-      BCTransactionFeeCommissionNotInRange
-    | -- | A change is already pending on this baker.
-      BCChangePending
-    | -- | This is not a valid baker.
-      BCInvalidBaker
-    deriving (Eq, Show)
-
--- | Result of remove baker.
-data BakerRemoveResult
-    = -- | The baker was removed, effective from the given epoch.
-      BRRemoved !BakerId !Epoch
-    | -- | This is not a valid baker.
-      BRInvalidBaker
-    | -- | A change is already pending on this baker.
-      BRChangePending !BakerId
-    deriving (Eq, Ord, Show)
-
 -- | Parameters for adding a delegator.
 data DelegatorAdd = DelegatorAdd
     { -- | The initial staked capital for the delegator.
@@ -358,24 +308,6 @@ delegatorRemove =
           duDelegationTarget = Nothing
         }
 
--- | Data structure used to add/remove/update delegator.
-data DelegationConfigure
-    = -- | Add a delegator, all fields are required.
-      DelegationConfigureAdd
-        { dcaCapital :: !Amount,
-          dcaRestakeEarnings :: !Bool,
-          dcaDelegationTarget :: !DelegationTarget
-        }
-    | -- | Update delegator with optional fields.
-      DelegationConfigureUpdate
-        { -- | The timestamp of the current slot (slot time of the block in which the update occurs).
-          dcuSlotTimestamp :: !Timestamp,
-          dcuCapital :: !(Maybe Amount),
-          dcuRestakeEarnings :: !(Maybe Bool),
-          dcuDelegationTarget :: !(Maybe DelegationTarget)
-        }
-    deriving (Eq, Show)
-
 -- | A delegation update change result from configure delegation. Used to indicate whether the
 --  configure will cause any changes to the delegator's stake, restake earnings flag, etc.
 data DelegationConfigureUpdateChange
@@ -400,26 +332,6 @@ data DelegatorConfigureFailure
       DCFChangePending
     deriving (Eq, Show)
 
--- | Result of configure delegator.
-data DelegationConfigureResult
-    = -- | Configure delegation successful.
-      DCSuccess ![DelegationConfigureUpdateChange] !DelegatorId
-    | -- | Account unknown.
-      DCInvalidAccount
-    | -- | A change is already pending on this delegator.
-      DCChangePending
-    | -- | This is not a valid delegator.
-      DCInvalidDelegator
-    | -- | Delegation target is not a valid baker.
-      DCInvalidDelegationTarget !BakerId
-    | -- | The pool is not open for delegators.
-      DCPoolClosed
-    | -- | The pool's total capital would become too large.
-      DCPoolStakeOverThreshold
-    | -- | The delegated capital would become too large in comparison with pool owner's equity capital.
-      DCPoolOverDelegated
-    deriving (Eq, Show)
-
 -- | Construct an 'AccountBaker' from a 'GenesisBaker'.
 --  For 'P4', this creates the baker with the initial pool status being open for all, the
 --  empty metadata URL and the maximum commission rates allowable under the chain parameters.
diff --git a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs
index a6e9480fc..2e2436bce 100644
--- a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs
@@ -975,97 +975,10 @@ class (BlockStateQuery m) => BlockStateOperations m where
         BakerAdd ->
         m (BakerAddResult, UpdatableBlockState m)
 
-    -- | From chain parameters version >= 1, this operation is used to add/remove/update a baker.
-    --  When adding baker, it is assumed that 'AccountIndex' account is NOT a baker and NOT a delegator.
-    --
-    --  When the argument is 'BakerConfigureAdd', the caller __must ensure__ that:
-    --  * the account is valid;
-    --  * the account is not a baker;
-    --  * the account is not a delegator;
-    --  * the account has sufficient balance to cover the stake.
-    --
-    --  The function behaves as follows:
-    --
-    --  1. If the account index is not valid, return 'BCInvalidAccount'.
-    --  2. If the baker's capital is less than the minimum threshold, return 'BCStakeUnderThreshold'.
-    --  3. If the transaction fee commission is not in the acceptable range, return
-    --     'BCTransactionFeeCommissionNotInRange'.
-    --  4. If the baking reward commission is not in the acceptable range, return
-    --     'BCBakingRewardCommissionNotInRange'.
-    --  5. If the finalization reward commission is not in the acceptable range, return
-    --     'BCFinalizationRewardCommissionNotInRange'.
-    --  6. If the aggregation key is a duplicate, return 'BCDuplicateAggregationKey'.
-    --  7. Add the baker to the account, updating the indexes as follows:
-    --     * add an empty pool for the baker in the active bakers;
-    --     * add the baker's equity capital to the total active capital;
-    --     * add the baker's aggregation key to the aggregation key set.
-    --  8. Return @BCSuccess []@.
-    --
-    --  When the argument is 'BakerConfigureUpdate', the caller __must ensure__ that:
-    --  * the account is valid;
-    --  * the account is a baker;
-    --  * if the stake is being updated, then the account balance exceeds the new stake.
-    --
-    --  The function behaves as follows, building a list @events@:
-    --
-    --  1. If keys are supplied: if the aggregation key duplicates an existing aggregation key @key@
-    --     (except this baker's current aggregation key), return @BCDuplicateAggregationKey key@;
-    --     otherwise, update the keys with the supplied @keys@, update the aggregation key index
-    --     (removing the old key and adding the new one), and append @BakerConfigureUpdateKeys keys@
-    --     to @events@.
-    --  2. If the restake earnings flag is supplied: update the account's flag to the supplied value
-    --     @restakeEarnings@ and append @BakerConfigureRestakeEarnings restakeEarnings@ to @events@.
-    --  3. If the open-for-delegation configuration is supplied:
-    --     (1) update the account's configuration to the supplied value @openForDelegation@;
-    --     (2) if @openForDelegation == ClosedForAll@, transfer all delegators in the baker's pool to
-    --         passive delegation; and
-    --     (3) append @BakerConfigureOpenForDelegation openForDelegation@ to @events@.
-    --  4. If the metadata URL is supplied: update the account's metadata URL to the supplied value
-    --     @metadataURL@ and append @BakerConfigureMetadataURL metadataURL@ to @events@.
-    --  5. If the transaction fee commission is supplied:
-    --     (1) if the commission does not fall within the current range according to the chain
-    --         parameters, return @BCTransactionFeeCommissionNotInRange@; otherwise,
-    --     (2) update the account's transaction fee commission rate to the the supplied value @tfc@;
-    --     (3) append @BakerConfigureTransactionFeeCommission tfc@ to @events@.
-    --  6. If the baking reward commission is supplied:
-    --     (1) if the commission does not fall within the current range according to the chain
-    --         parameters, return @BCBakingRewardCommissionNotInRange@; otherwise,
-    --     (2) update the account's baking reward commission rate to the the supplied value @brc@;
-    --     (3) append @BakerConfigureBakingRewardCommission brc@ to @events@.
-    --  6. If the finalization reward commission is supplied:
-    --     (1) if the commission does not fall within the current range according to the chain
-    --         parameters, return @BCFinalizationRewardCommissionNotInRange@; otherwise,
-    --     (2) update the account's finalization reward commission rate to the the supplied value @frc@;
-    --     (3) append @BakerConfigureFinalizationRewardCommission frc@ to @events@.
-    --  7. If the capital is supplied: if there is a pending change to the baker's capital, return
-    --     @BCChangePending@; otherwise:
-    --     * if the capital is 0, mark the baker as pending removal at @bcuSlotTimestamp@ plus the
-    --       the current baker cooldown period according to the chain parameters, and append
-    --       @BakerConfigureStakeReduced 0@ to @events@;
-    --     * if the capital is less than the current minimum equity capital, return @BCStakeUnderThreshold@;
-    --     * if the capital is (otherwise) less than the current equity capital of the baker, mark the
-    --       baker as pending stake reduction to the new capital at @bcuSlotTimestamp@ plus the
-    --       current baker cooldown period according to the chain parameters and append
-    --       @BakerConfigureStakeReduced capital@ to @events@;
-    --     * if the capital is equal to the baker's current equity capital, do nothing, append
-    --       @BakerConfigureStakeIncreased capital@ to @events@;
-    --     * if the capital is greater than the baker's current equity capital, increase the baker's
-    --       equity capital to the new capital (updating the total active capital in the active baker
-    --       index by adding the difference between the new and old capital) and append
-    --       @BakerConfigureStakeIncreased capital@ to @events@.
-    --  8. return @BCSuccess events bid@, where @bid@ is the baker's ID.
-    --
-    --  Note: in the case of an early return (i.e. not @BCSuccess@), the state is not updated.
-    bsoConfigureBaker ::
-        (PVSupportsDelegation (MPV m)) =>
-        UpdatableBlockState m ->
-        AccountIndex ->
-        BakerConfigure ->
-        m (BakerConfigureResult, UpdatableBlockState m)
-
     -- | From chain parameters version >= 1, this adds a validator for an account.
     --
     --  PRECONDITIONS:
+    --
     --  * the account is valid;
     --  * the account is not a baker;
     --  * the account is not a delegator;
@@ -1081,10 +994,15 @@ class (BlockStateQuery m) => BlockStateOperations m where
     --  4. If the finalization reward commission is not in the acceptable range, return
     --     'VCFFinalizationRewardCommissionNotInRange'.
     --  5. If the aggregation key is a duplicate, return 'VCFDuplicateAggregationKey'.
-    --  6. Add the baker to the account, updating the indexes as follows:
-    --     * add an empty pool for the baker in the active bakers;
-    --     * add the baker's equity capital to the total active capital;
-    --     * add the baker's aggregation key to the aggregation key set.
+    --  6. Add the baker to the account. If flexible cooldowns are supported by the protocol
+    --     version, then the capital in cooldown is reactivated. The indexes are updated as follows:
+    --
+    --       * add an empty pool for the baker in the active bakers;
+    --       * add the baker's equity capital to the total active capital;
+    --       * add the baker's aggregation key to the aggregation key set;
+    --       * the cooldown indexes are updated to reflect any reactivation of capital.
+    --
+    --  7. Return the updated block state.
     bsoAddValidator ::
         (PVSupportsDelegation (MPV m)) =>
         UpdatableBlockState m ->
@@ -1095,6 +1013,7 @@ class (BlockStateQuery m) => BlockStateOperations m where
     -- | Update the validator for an account.
     --
     --  PRECONDITIONS:
+    --
     --  * the account is valid;
     --  * the account is a baker;
     --  * if the stake is being updated, then the account balance exceeds the new stake.
@@ -1102,54 +1021,92 @@ class (BlockStateQuery m) => BlockStateOperations m where
     --  The function behaves as follows, building a list @events@:
     --
     --  1. If keys are supplied: if the aggregation key duplicates an existing aggregation key @key@
-    --     (except this baker's current aggregation key), return @BCDuplicateAggregationKey key@;
+    --     (except the accounts's current aggregation key), return @VCFDuplicateAggregationKey key@;
     --     otherwise, update the keys with the supplied @keys@, update the aggregation key index
     --     (removing the old key and adding the new one), and append @BakerConfigureUpdateKeys keys@
     --     to @events@.
+    --
     --  2. If the restake earnings flag is supplied: update the account's flag to the supplied value
     --     @restakeEarnings@ and append @BakerConfigureRestakeEarnings restakeEarnings@ to @events@.
+    --
     --  3. If the open-for-delegation configuration is supplied:
-    --     (1) update the account's configuration to the supplied value @openForDelegation@;
-    --     (2) if @openForDelegation == ClosedForAll@, transfer all delegators in the baker's pool to
-    --         passive delegation; and
-    --     (3) append @BakerConfigureOpenForDelegation openForDelegation@ to @events@.
+    --
+    --         (1) update the account's configuration to the supplied value @openForDelegation@;
+    --
+    --         (2) if @openForDelegation == ClosedForAll@, transfer all delegators in the baker's pool to
+    --             passive delegation; and
+    --
+    --         (3) append @BakerConfigureOpenForDelegation openForDelegation@ to @events@.
+    --
     --  4. If the metadata URL is supplied: update the account's metadata URL to the supplied value
     --     @metadataURL@ and append @BakerConfigureMetadataURL metadataURL@ to @events@.
+    --
     --  5. If the transaction fee commission is supplied:
-    --     (1) if the commission does not fall within the current range according to the chain
-    --         parameters, return @BCTransactionFeeCommissionNotInRange@; otherwise,
-    --     (2) update the account's transaction fee commission rate to the the supplied value @tfc@;
-    --     (3) append @BakerConfigureTransactionFeeCommission tfc@ to @events@.
+    --
+    --        (1) if the commission does not fall within the current range according to the chain
+    --            parameters, return @VCFTransactionFeeCommissionNotInRange@; otherwise,
+    --
+    --        (2) update the account's transaction fee commission rate to the the supplied value @tfc@;
+    --
+    --        (3) append @BakerConfigureTransactionFeeCommission tfc@ to @events@.
+    --
     --  6. If the baking reward commission is supplied:
-    --     (1) if the commission does not fall within the current range according to the chain
-    --         parameters, return @BCBakingRewardCommissionNotInRange@; otherwise,
-    --     (2) update the account's baking reward commission rate to the the supplied value @brc@;
-    --     (3) append @BakerConfigureBakingRewardCommission brc@ to @events@.
+    --
+    --        (1) if the commission does not fall within the current range according to the chain
+    --            parameters, return @VCFBakingRewardCommissionNotInRange@; otherwise,
+    --
+    --        (2) update the account's baking reward commission rate to the the supplied value @brc@;
+    --
+    --        (3) append @BakerConfigureBakingRewardCommission brc@ to @events@.
+    --
     --  6. If the finalization reward commission is supplied:
-    --     (1) if the commission does not fall within the current range according to the chain
-    --         parameters, return @BCFinalizationRewardCommissionNotInRange@; otherwise,
-    --     (2) update the account's finalization reward commission rate to the the supplied value @frc@;
-    --     (3) append @BakerConfigureFinalizationRewardCommission frc@ to @events@.
+    --
+    --        (1) if the commission does not fall within the current range according to the chain
+    --            parameters, return @VCFFinalizationRewardCommissionNotInRange@; otherwise,
+    --
+    --        (2) update the account's finalization reward commission rate to the the supplied value @frc@;
+    --
+    --        (3) append @BakerConfigureFinalizationRewardCommission frc@ to @events@.
+    --
     --  7. If the capital is supplied: if there is a pending change to the baker's capital, return
-    --     @BCChangePending@; otherwise:
-    --     * if the capital is 0, mark the baker as pending removal at @bcuSlotTimestamp@ plus the
-    --       the current baker cooldown period according to the chain parameters, and append
-    --       @BakerConfigureStakeReduced 0@ to @events@;
-    --     * if the capital is less than the current minimum equity capital, return @BCStakeUnderThreshold@;
-    --     * if the capital is (otherwise) less than the current equity capital of the baker, mark the
-    --       baker as pending stake reduction to the new capital at @bcuSlotTimestamp@ plus the
-    --       current baker cooldown period according to the chain parameters and append
-    --       @BakerConfigureStakeReduced capital@ to @events@;
-    --     * if the capital is equal to the baker's current equity capital, do nothing, append
-    --       @BakerConfigureStakeIncreased capital@ to @events@;
-    --     * if the capital is greater than the baker's current equity capital, increase the baker's
-    --       equity capital to the new capital (updating the total active capital in the active baker
-    --       index by adding the difference between the new and old capital) and append
-    --       @BakerConfigureStakeIncreased capital@ to @events@.
-    --  8. return @BCSuccess events bid@, where @bid@ is the baker's ID.
+    --     @VCFChangePending@; otherwise:
+    --
+    --       * if the capital is 0
+    --
+    --           - (< P7) mark the baker as pending removal at @bcuSlotTimestamp@ plus the
+    --           the current baker cooldown period according to the chain parameters
+    --
+    --           - (>= P7) transfer the existing staked capital to pre-pre-cooldown, and mark the
+    --           account as in pre-pre-cooldown (in the global index) if it wasn't already
+    --
+    --           - append @BakerConfigureStakeReduced 0@ to @events@;
+    --
+    --       * if the capital is less than the current minimum equity capital, return @BCStakeUnderThreshold@;
+    --
+    --       * if the capital is (otherwise) less than the current equity capital of the baker
+    --
+    --           - (< P7) mark the baker as pending stake reduction to the new capital at
+    --             @bcuSlotTimestamp@ plus the current baker cooldown period according to the chain
+    --             parameters
+    --
+    --           - (>= P7) transfer the decrease in staked capital to pre-pre-cooldown, and mark the
+    --             account as in pre-pre-cooldown (in the global index) if it wasn't already
+    --
+    --           - append @BakerConfigureStakeReduced capital@ to @events@;
+    --
+    --       * if the capital is equal to the baker's current equity capital, do nothing, append
+    --         @BakerConfigureStakeIncreased capital@ to @events@;
+    --
+    --       * if the capital is greater than the baker's current equity capital, increase the baker's
+    --         equity capital to the new capital (updating the total active capital in the active baker
+    --         index by adding the difference between the new and old capital) and append
+    --         @BakerConfigureStakeIncreased capital@ to @events@.
+    --
+    --  8. Return @events@ with the updated block state.
     bsoUpdateValidator ::
         (PVSupportsDelegation (MPV m)) =>
         UpdatableBlockState m ->
+        -- | Current timestamp of the block.
         Timestamp ->
         AccountIndex ->
         ValidatorUpdate ->
@@ -1164,10 +1121,11 @@ class (BlockStateQuery m) => BlockStateOperations m where
         CommissionRanges ->
         m (UpdatableBlockState m)
 
-    -- | From chain parameters version >= 1, this operation is used to add/remove/update a delegator.
+    -- | From chain parameters version >= 1, this operation is used to add a delegator.
     --  When adding delegator, it is assumed that 'AccountIndex' account is NOT a baker and NOT a delegator.
     --
-    --  When the argument is 'DelegationConfigureAdd', the caller __must ensure__ that:
+    --  PRECONDITIONS:
+    --
     --  * the account is valid;
     --  * the account is not a baker;
     --  * the account is not a delegator;
@@ -1175,21 +1133,38 @@ class (BlockStateQuery m) => BlockStateOperations m where
     --
     --  The function behaves as follows:
     --
-    --  1. If the delegation target is a valid baker that is not 'OpenForAll', return 'DCPoolClosed'.
+    --  1. If the delegation target is a valid baker that is not 'OpenForAll', return 'DCFPoolClosed'.
+    --
     --  2. If the delegation target is baker id @bid@, but the baker does not exist, return
-    --     @DCInvalidDelegationTarget bid@.
+    --     @DCFInvalidDelegationTarget bid@.
+    --
     --  3. Update the active bakers index to record:
-    --     * the delegator delegates to the target pool;
-    --     * the target pool's delegated capital is increased by the delegated amount;
-    --     * the total active capital is increased by the delegated amount.
+    --
+    --       * the delegator delegates to the target pool;
+    --       * the target pool's delegated capital is increased by the delegated amount;
+    --       * the total active capital is increased by the delegated amount.
+    --
     --  4. Update the account to record the specified delegation.
+    --
     --  5. If the amount delegated to the delegation target exceeds the leverage bound, return
-    --     'DCPoolStakeOverThreshold' and revert any changes.
+    --     'DCFPoolStakeOverThreshold' and revert any changes.
+    --
     --  6. If the amount delegated to the delegation target exceed the capital bound, return
-    --     'DCPoolOverDelegated' and revert any changes.
-    --  7. Return @DCSuccess []@ with the updated state.
+    --     'DCFPoolOverDelegated' and revert any changes.
+    --
+    --  7. Return the updated state.
+    bsoAddDelegator ::
+        (PVSupportsDelegation (MPV m)) =>
+        UpdatableBlockState m ->
+        AccountIndex ->
+        DelegatorAdd ->
+        m (Either DelegatorConfigureFailure (UpdatableBlockState m))
+
+    -- | From chain parameters version >= 1, this operation is used to update or remove a delegator.
+    --  It is assumed that the account is already a delegator.
+    --
+    --  PRECONDITIONS:
     --
-    --  When the argument is 'DelegationConfigureUpdate', the caller __must ensure__ that:
     --  * the account is valid;
     --  * the account is a delegator;
     --  * if the delegated amount is updated, it does not exceed the account's balance.
@@ -1197,64 +1172,65 @@ class (BlockStateQuery m) => BlockStateOperations m where
     --  The function behaves as follows, building a list @events@:
     --
     --  1. If the delegation target is specified as @target@:
-    --     (1) If the delegation target is a valid baker that is not 'OpenForAll', return 'DCPoolClosed'.
-    --     (2) If the delegation target is baker id @bid@, but the baker does not exist, return
-    --         @DCInvalidDelegationTarget bid@.
-    --     (3) Update the active bakers index to: remove the delegator and delegated amount from the
-    --         old baker pool, and add the delegator and delegated amount to the new baker pool.
-    --         (Note, the total delegated amount is unchanged at this point.)
-    --     (4) Update the account to record the new delegation target.
-    --     (5) Append @DelegationConfigureDelegationTarget target@ to @events@. [N.B. if the target is
-    --         pool is the same as the previous value, steps (1)-(4) will do nothing and may be skipped
-    --         by the implementation. This relies on the invariant that delegators delegate only to
-    --         valid pools.]
+    --
+    --       (1) If the delegation target is a valid baker that is not 'OpenForAll', return 'DCPoolClosed'.
+    --
+    --       (2) If the delegation target is baker id @bid@, but the baker does not exist, return
+    --           @DCFInvalidDelegationTarget bid@.
+    --
+    --       (3) Update the active bakers index to: remove the delegator and delegated amount from the
+    --           old baker pool, and add the delegator and delegated amount to the new baker pool.
+    --           (Note, the total delegated amount is unchanged at this point.)
+    --
+    --       (4) Update the account to record the new delegation target.
+    --
+    --       (5) Append @DelegationConfigureDelegationTarget target@ to @events@. [N.B. if the target is
+    --           pool is the same as the previous value, steps (1)-(4) will do nothing and may be skipped
+    --           by the implementation. This relies on the invariant that delegators delegate only to
+    --           valid pools.]
+    --
     --  2. If the "restake earnings" flag is specified as @restakeEarnings@:
-    --     (1) Update the restake earnings flag on the account to match @restakeEarnings@.
-    --     (2) Append @DelegationConfigureRestakeEarnings restakeEarnings@ to @events@.
+    --
+    --       (1) Update the restake earnings flag on the account to match @restakeEarnings@.
+    --
+    --       (2) Append @DelegationConfigureRestakeEarnings restakeEarnings@ to @events@.
+    --
     --  3. If the delegated capital is specified as @capital@: if there is a pending change to the
-    --     delegator's stake, return 'DCChangePending'; otherwise:
-    --     * If the new capital is 0, mark the delegator as pending removal at the slot timestamp
-    --       plus the delegator cooldown chain parameter, and append
-    --       @DelegationConfigureStakeReduced capital@ to @events@; otherwise
-    --     * If the the new capital is less than the current staked capital (but not 0), mark the
-    --       delegator as pending stake reduction to @capital@ at the slot timestamp plus the
-    --       delegator cooldown chain parameter, and append @DelegationConfigureStakeReduced capital@
-    --       to @events@;
-    --     * If the new capital is equal to the current staked capital, append
-    --       @DelegationConfigureStakeIncreased capital@ to @events@.
-    --     * If the new capital is greater than the current staked capital by @delta > 0@:
-    --       * increase the total active capital by @delta@,
-    --       * increase the delegator's target pool delegated capital by @delta@,
-    --       * set the baker's delegated capital to @capital@, and
-    --       * append @DelegationConfigureStakeIncreased capital@ to @events@.
+    --     delegator's stake, return 'DCFChangePending'; otherwise:
+    --
+    --       * If the new capital is 0, mark the delegator as pending removal at the slot timestamp
+    --         plus the delegator cooldown chain parameter, and append
+    --         @DelegationConfigureStakeReduced capital@ to @events@; otherwise
+    --
+    --       * If the the new capital is less than the current staked capital (but not 0), mark the
+    --         delegator as pending stake reduction to @capital@ at the slot timestamp plus the
+    --         delegator cooldown chain parameter, and append @DelegationConfigureStakeReduced capital@
+    --         to @events@;
+    --
+    --       * If the new capital is equal to the current staked capital, append
+    --         @DelegationConfigureStakeIncreased capital@ to @events@.
+    --
+    --       * If the new capital is greater than the current staked capital by @delta > 0@:
+    --
+    --             * increase the total active capital by @delta@,
+    --
+    --             * increase the delegator's target pool delegated capital by @delta@,
+    --
+    --             * set the baker's delegated capital to @capital@, and
+    --
+    --             * append @DelegationConfigureStakeIncreased capital@ to @events@.
+    --
     --  4. If the amount delegated to the delegation target exceeds the leverage bound, return
-    --     'DCPoolStakeOverThreshold' and revert any changes.
+    --     'DCFPoolStakeOverThreshold' and revert any changes.
+    --
     --  5. If the amount delegated to the delegation target exceed the capital bound, return
-    --     'DCPoolOverDelegated' and revert any changes.
-    --  6. Return @DCSuccess events@ with the updated state.
-    --
-    --  Note, if the return code is anything other than 'DCSuccess', the original state is returned.
-    --  If the preconditions are violated, the function may return 'DCInvalidAccount' (if the account
-    --  is not valid) or 'DCInvalidDelegator' (when updating, if the account is not a delegator).
-    --  However, this behaviour is not guaranteed, and could result in violations of the state
-    --  invariants.
-    bsoConfigureDelegation ::
-        (PVSupportsDelegation (MPV m)) =>
-        UpdatableBlockState m ->
-        AccountIndex ->
-        DelegationConfigure ->
-        m (DelegationConfigureResult, UpdatableBlockState m)
-
-    bsoAddDelegator ::
-        (PVSupportsDelegation (MPV m)) =>
-        UpdatableBlockState m ->
-        AccountIndex ->
-        DelegatorAdd ->
-        m (Either DelegatorConfigureFailure (UpdatableBlockState m))
-
+    --     'DCFPoolOverDelegated' and revert any changes.
+    --
+    --  6. Return @events@ with the updated state.
     bsoUpdateDelegator ::
         (PVSupportsDelegation (MPV m)) =>
         UpdatableBlockState m ->
+        -- | The current timestamp of the block.
         Timestamp ->
         AccountIndex ->
         DelegatorUpdate ->
@@ -1754,13 +1730,11 @@ instance (Monad (t m), MonadTrans t, BlockStateOperations m) => BlockStateOperat
     bsoGetCurrentEpochFullBakersEx = lift . bsoGetCurrentEpochFullBakersEx
     bsoGetCurrentCapitalDistribution = lift . bsoGetCurrentCapitalDistribution
     bsoAddBaker s addr a = lift $ bsoAddBaker s addr a
-    bsoConfigureBaker s aconfig a = lift $ bsoConfigureBaker s aconfig a
     bsoAddValidator s ai a = lift $ bsoAddValidator s ai a
     bsoUpdateValidator s ts ai upd = lift $ bsoUpdateValidator s ts ai upd
     bsoConstrainBakerCommission s acct ranges = lift $ bsoConstrainBakerCommission s acct ranges
     bsoAddDelegator s ai a = lift $ bsoAddDelegator s ai a
     bsoUpdateDelegator s ts ai a = lift $ bsoUpdateDelegator s ts ai a
-    bsoConfigureDelegation s aconfig a = lift $ bsoConfigureDelegation s aconfig a
     bsoUpdateBakerKeys s addr a = lift $ bsoUpdateBakerKeys s addr a
     bsoUpdateBakerStake s addr a = lift $ bsoUpdateBakerStake s addr a
     bsoUpdateBakerRestakeEarnings s addr a = lift $ bsoUpdateBakerRestakeEarnings s addr a
@@ -1822,7 +1796,10 @@ instance (Monad (t m), MonadTrans t, BlockStateOperations m) => BlockStateOperat
     {-# INLINE bsoSetSeedState #-}
     {-# INLINE bsoTransitionEpochBakers #-}
     {-# INLINE bsoAddBaker #-}
-    {-# INLINE bsoConfigureBaker #-}
+    {-# INLINE bsoAddValidator #-}
+    {-# INLINE bsoUpdateValidator #-}
+    {-# INLINE bsoAddDelegator #-}
+    {-# INLINE bsoUpdateDelegator #-}
     {-# INLINE bsoUpdateBakerKeys #-}
     {-# INLINE bsoUpdateBakerStake #-}
     {-# INLINE bsoUpdateBakerRestakeEarnings #-}
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
index bdacd182a..da5a5667b 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
@@ -10,9 +10,9 @@
 -- for pattern matching. (See: https://gitlab.haskell.org/ghc/ghc/-/issues/20896)
 {-# OPTIONS_GHC -Wno-redundant-constraints #-}
 
--- | This module implements accounts for account versions 'AccountV2' (protocol 'P5').
---  It should not be necessary to use this module directly, but instead through the interface
---  provided by 'Concordium.GlobalState.Persistent.Account'.
+-- | This module implements accounts for account versions 'AccountV2' (protocol 'P5', 'P6')
+--  and 'AccountV3' (protocol 'P7').  It should not be necessary to use this module directly,
+--  but instead through the interface provided by "Concordium.GlobalState.Persistent.Account".
 module Concordium.GlobalState.Persistent.Account.StructureV1 where
 
 import Control.Monad
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
index 0cbcec3f0..d2fc17d18 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
@@ -1865,492 +1865,6 @@ newUpdateValidator pbs curTimestamp ai vu@ValidatorUpdate{..} = do
                 (bspAccountsInCooldown bsp)
         return bsp{bspAccountsInCooldown = newAccountsInCooldown}
 
-doConfigureBaker ::
-    forall pv m.
-    ( SupportsPersistentState pv m,
-      PVSupportsDelegation pv,
-      IsSupported 'PTTimeParameters (ChainParametersVersionFor pv) ~ 'True,
-      PoolParametersVersionFor (ChainParametersVersionFor pv) ~ 'PoolParametersVersion1,
-      CooldownParametersVersionFor (ChainParametersVersionFor pv) ~ 'CooldownParametersVersion1
-    ) =>
-    PersistentBlockState pv ->
-    AccountIndex ->
-    BakerConfigure ->
-    m (BakerConfigureResult, PersistentBlockState pv)
-doConfigureBaker pbs ai BakerConfigureAdd{..} = do
-    -- FIXME: Support using stake that is in cooldown.
-    -- It is assumed here that this account is NOT a baker and NOT a delegator.
-    bsp <- loadPBS pbs
-    Accounts.indexedAccount ai (bspAccounts bsp) >>= \case
-        -- Cannot resolve the account
-        Nothing -> return (BCInvalidAccount, pbs)
-        Just acc -> do
-            chainParams <- lookupCurrentParameters (bspUpdates bsp)
-            let poolParams = chainParams ^. cpPoolParameters
-            let capitalMin = poolParams ^. ppMinimumEquityCapital
-            let ranges = poolParams ^. ppCommissionBounds
-            if
-                | bcaCapital < capitalMin -> return (BCStakeUnderThreshold, pbs)
-                | not (isInRange bcaTransactionFeeCommission (ranges ^. transactionCommissionRange)) ->
-                    return (BCTransactionFeeCommissionNotInRange, pbs)
-                | not (isInRange bcaBakingRewardCommission (ranges ^. bakingCommissionRange)) ->
-                    return (BCBakingRewardCommissionNotInRange, pbs)
-                | not (isInRange bcaFinalizationRewardCommission (ranges ^. finalizationCommissionRange)) ->
-                    return (BCFinalizationRewardCommissionNotInRange, pbs)
-                | otherwise -> do
-                    let bid = BakerId ai
-                    oldPAB <- refLoad (_birkActiveBakers (bspBirkParameters bsp))
-                    maybeDel <- accountDelegator acc
-                    pab <- maybeRemoveDelegator (sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv))) maybeDel oldPAB
-                    let updAgg Nothing = return (True, Trie.Insert ())
-                        updAgg (Just ()) = return (False, Trie.NoChange)
-                    Trie.adjust updAgg (bkuAggregationKey bcaKeys) (_aggregationKeys pab) >>= \case
-                        -- Aggregation key is a duplicate
-                        (False, _) -> return (BCDuplicateAggregationKey (bkuAggregationKey bcaKeys), pbs)
-                        (True, newAggregationKeys) -> do
-                            newActiveBakers <- Trie.insert bid emptyPersistentActiveDelegators (_activeBakers pab)
-                            newpabref <-
-                                refMake
-                                    PersistentActiveBakers
-                                        { _aggregationKeys = newAggregationKeys,
-                                          _activeBakers = newActiveBakers,
-                                          _passiveDelegators = pab ^. passiveDelegators,
-                                          _totalActiveCapital = addActiveCapital bcaCapital (_totalActiveCapital pab)
-                                        }
-                            let newBirkParams = bspBirkParameters bsp & birkActiveBakers .~ newpabref
-                            let cr =
-                                    CommissionRates
-                                        { _finalizationCommission = bcaFinalizationRewardCommission,
-                                          _bakingCommission = bcaBakingRewardCommission,
-                                          _transactionCommission = bcaTransactionFeeCommission
-                                        }
-                                poolInfo =
-                                    BaseAccounts.BakerPoolInfo
-                                        { _poolOpenStatus = bcaOpenForDelegation,
-                                          _poolMetadataUrl = bcaMetadataURL,
-                                          _poolCommissionRates = cr
-                                        }
-                                bakerInfo = bakerKeyUpdateToInfo bid bcaKeys
-                                bakerInfoEx =
-                                    BaseAccounts.BakerInfoExV1
-                                        { _bieBakerPoolInfo = poolInfo,
-                                          _bieBakerInfo = bakerInfo
-                                        }
-                                updAcc = addAccountBakerV1 bakerInfoEx bcaCapital bcaRestakeEarnings
-                            newBSP <-
-                                updateAccountsAndMaybeCooldown
-                                    (sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv)))
-                                    acc
-                                    maybeDel
-                                    updAcc
-                                    bcaCapital
-                                    bsp{bspBirkParameters = newBirkParams}
-                            (BCSuccess [] bid,)
-                                <$> storePBS
-                                    pbs
-                                    newBSP
-  where
-    maybeRemoveDelegator ::
-        SBool (SupportsFlexibleCooldown (AccountVersionFor pv)) ->
-        Maybe (BaseAccounts.AccountDelegation (AccountVersionFor pv)) ->
-        PersistentActiveBakers (AccountVersionFor pv) ->
-        m (PersistentActiveBakers (AccountVersionFor pv))
-    maybeRemoveDelegator SFalse _ pab = return pab
-    maybeRemoveDelegator STrue Nothing pab = return pab
-    maybeRemoveDelegator STrue (Just del) pab = do
-        let delStake = BaseAccounts._delegationStakedAmount del
-            pab1 = pab & totalActiveCapital %~ subtractActiveCapital delStake
-        case del ^. BaseAccounts.delegationTarget of
-            Transactions.DelegatePassive -> do
-                let PersistentActiveDelegatorsV1 dset dtot = pab1 ^. passiveDelegators
-                newDelegatorSet <- Trie.delete (del ^. BaseAccounts.delegationIdentity) dset
-                return $ pab1 & passiveDelegators .~ PersistentActiveDelegatorsV1 newDelegatorSet (dtot - delStake)
-            Transactions.DelegateToBaker bid -> do
-                Trie.lookup bid (pab ^. activeBakers) >>= \case
-                    Nothing -> error "Invariant violation: delegation target is not an active baker"
-                    Just (PersistentActiveDelegatorsV1 dset dtot) -> do
-                        newDelegatorSet <- Trie.delete (del ^. BaseAccounts.delegationIdentity) dset
-                        newActiveMap <- Trie.insert bid (PersistentActiveDelegatorsV1 newDelegatorSet (dtot - delStake)) (pab1 ^. activeBakers)
-                        return $ pab1 & activeBakers .~ newActiveMap
-    updateAccountsAndMaybeCooldown ::
-        SBool (SupportsFlexibleCooldown (AccountVersionFor pv)) ->
-        PersistentAccount (AccountVersionFor pv) ->
-        Maybe (BaseAccounts.AccountDelegation (AccountVersionFor pv)) ->
-        (PersistentAccount (AccountVersionFor pv) -> m (PersistentAccount (AccountVersionFor pv))) ->
-        Amount ->
-        BlockStatePointers pv ->
-        m (BlockStatePointers pv)
-    updateAccountsAndMaybeCooldown SFalse _ _ updAcc _ bsp = do
-        -- This cannot fail to update the account, since we already looked up the account.
-        newAccounts <- Accounts.updateAccountsAtIndex' updAcc ai (bspAccounts bsp)
-        return bsp{bspAccounts = newAccounts}
-    updateAccountsAndMaybeCooldown STrue acc maybeDel updAcc capital bsp = do
-        case maybeDel of
-            Nothing -> do
-                maybeCooldownsBefore <- accountCooldowns acc
-                newAcc <- (updAcc >=> reactivateCooldownAmount capital) acc
-                -- This cannot fail to update the account, since we already looked up the account.
-                newAccounts <- Accounts.setAccountAtIndex ai newAcc (bspAccounts bsp)
-                maybeCooldownsAfter <- accountCooldowns newAcc
-                let removals = cooldownRemovals maybeCooldownsBefore maybeCooldownsAfter
-                newCooldowns <- applyCooldownRemovalsGlobally ai removals (bspAccountsInCooldown bsp)
-                return bsp{bspAccounts = newAccounts, bspAccountsInCooldown = newCooldowns}
-            Just del -> do
-                case compare capital (BaseAccounts._delegationStakedAmount del) of
-                    LT -> do
-                        -- This cannot fail to update the account, since we already looked up the account.
-                        newAccounts <-
-                            Accounts.updateAccountsAtIndex'
-                                (updAcc >=> addAccountPrePreCooldown (BaseAccounts._delegationStakedAmount del - capital))
-                                ai
-                                (bspAccounts bsp)
-                        let notAlreadyInPrePreCooldown = do
-                                let accountsInCooldownForPV = bspAccountsInCooldown bsp
-                                let oldAccountsInCooldown = case theAccountsInCooldownForPV accountsInCooldownForPV of
-                                        CTrue accounts -> accounts
-                                    oldPrePreCooldowns = _prePreCooldown oldAccountsInCooldown
-                                ppRef <- refMake $ AccountListItem ai oldPrePreCooldowns
-                                let newPrePreCooldowns = Some ppRef
-                                    newAccountsInCooldown =
-                                        AccountsInCooldownForPV $
-                                            CTrue
-                                                oldAccountsInCooldown{_prePreCooldown = newPrePreCooldowns}
-                                return
-                                    bsp
-                                        { bspAccounts = newAccounts,
-                                          bspAccountsInCooldown = newAccountsInCooldown
-                                        }
-                        maybeCooldowns <- accountCooldowns acc
-                        case maybeCooldowns of
-                            Nothing -> notAlreadyInPrePreCooldown
-                            Just cooldowns -> case CooldownQueue.prePreCooldown cooldowns of
-                                Absent -> notAlreadyInPrePreCooldown
-                                Present _ ->
-                                    return bsp{bspAccounts = newAccounts}
-                    EQ -> do
-                        -- This cannot fail to update the account, since we already looked up the account.
-                        newAccounts <- Accounts.updateAccountsAtIndex' updAcc ai (bspAccounts bsp)
-                        return bsp{bspAccounts = newAccounts}
-                    GT -> do
-                        maybeCooldownsBefore <- accountCooldowns acc
-                        -- This cannot fail to update the account, since we already looked up the account.
-                        newAcc <- (updAcc >=> reactivateCooldownAmount (capital - BaseAccounts._delegationStakedAmount del)) acc
-                        newAccounts <- Accounts.setAccountAtIndex ai newAcc (bspAccounts bsp)
-                        maybeCooldownsAfter <- accountCooldowns newAcc
-                        let removals = cooldownRemovals maybeCooldownsBefore maybeCooldownsAfter
-                        newCooldowns <- applyCooldownRemovalsGlobally ai removals (bspAccountsInCooldown bsp)
-                        return bsp{bspAccounts = newAccounts, bspAccountsInCooldown = newCooldowns}
-doConfigureBaker pbs ai BakerConfigureUpdate{..} = do
-    origBSP <- loadPBS pbs
-    cp <- lookupCurrentParameters (bspUpdates origBSP)
-    res <- MTL.runExceptT $ MTL.runWriterT $ flip MTL.execStateT origBSP $ do
-        (baker, acc) <- getAccountOrFail
-        -- Check the various updates are OK, getting the transformation on the account
-        -- implied by each.
-        uKeys <- updateKeys baker
-        uRestake <- updateRestakeEarnings baker
-        uPoolInfo <- updateBakerPoolInfo baker cp
-        uCapital <- updateCapital (sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv))) baker cp acc
-        -- Compose together the transformations and apply them to the account.
-        let updAcc = uKeys >=> uRestake >=> uPoolInfo
-        modifyAccount' updAcc
-        maybeReleaseCooldownGlobally (sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv))) uCapital acc
-    case res of
-        Left errorRes -> return (errorRes, pbs)
-        Right (newBSP, changes) -> (BCSuccess changes bid,) <$> storePBS pbs newBSP
-  where
-    -- Lift a monadic action over the ExceptT, WriterT and StateT layers.
-    liftBSO = lift . lift . lift
-    bid = BakerId ai
-    getAccountOrFail ::
-        MTL.StateT
-            (BlockStatePointers pv)
-            (MTL.WriterT [BakerConfigureUpdateChange] (MTL.ExceptT BakerConfigureResult m))
-            (AccountBaker (AccountVersionFor pv), PersistentAccount (AccountVersionFor pv))
-    getAccountOrFail = do
-        bsp <- MTL.get
-        liftBSO (Accounts.indexedAccount ai (bspAccounts bsp)) >>= \case
-            Nothing -> MTL.throwError BCInvalidAccount
-            Just acc ->
-                accountBaker acc >>= \case
-                    Nothing -> MTL.throwError BCInvalidBaker
-                    Just bkr -> return (bkr, acc)
-    modifyAccount' updAcc = do
-        bsp <- MTL.get
-        newAccounts <- liftBSO $ Accounts.updateAccountsAtIndex' updAcc ai (bspAccounts bsp)
-        MTL.put bsp{bspAccounts = newAccounts}
-    setAccount acc = do
-        bsp <- MTL.get
-        newAccounts <- liftBSO $ Accounts.setAccountAtIndex ai acc (bspAccounts bsp)
-        MTL.put
-            bsp
-                { bspAccounts = newAccounts
-                }
-    ifPresent Nothing _ = return return
-    ifPresent (Just v) k = k v
-    updateKeys oldBkr = ifPresent bcuKeys $ \keys -> do
-        bsp <- MTL.get
-        pab <- liftBSO $ refLoad (_birkActiveBakers (bspBirkParameters bsp))
-        let key = oldBkr ^. BaseAccounts.bakerAggregationVerifyKey
-        -- Try updating the aggregation keys
-        (keyOK, newAggregationKeys) <-
-            -- If the aggregation key has not changed, we have nothing to do.
-            if bkuAggregationKey keys == key
-                then return (True, _aggregationKeys pab)
-                else do
-                    -- Remove the old key
-                    ak1 <- liftBSO $ Trie.delete key (_aggregationKeys pab)
-                    -- Add the new key and check that it is not already present
-                    let updAgg Nothing = return (True, Trie.Insert ())
-                        updAgg (Just ()) = return (False, Trie.NoChange)
-                    liftBSO $ Trie.adjust updAgg (bkuAggregationKey keys) ak1
-        unless keyOK (MTL.throwError (BCDuplicateAggregationKey key))
-        newActiveBakers <- liftBSO $ refMake pab{_aggregationKeys = newAggregationKeys}
-        let newBirkParams = bspBirkParameters bsp & birkActiveBakers .~ newActiveBakers
-        MTL.modify' $ \s -> s{bspBirkParameters = newBirkParams}
-        MTL.tell [BakerConfigureUpdateKeys keys]
-        -- Update the account with the new keys
-        return (setAccountBakerKeys keys)
-    updateRestakeEarnings oldBkr = ifPresent bcuRestakeEarnings $ \restakeEarnings -> do
-        MTL.tell [BakerConfigureRestakeEarnings restakeEarnings]
-        if oldBkr ^. BaseAccounts.stakeEarnings == restakeEarnings
-            then return return
-            else return $ setAccountRestakeEarnings restakeEarnings
-    updateBakerPoolInfo ::
-        AccountBaker (AccountVersionFor pv) ->
-        ChainParameters pv ->
-        MTL.StateT
-            (BlockStatePointers pv)
-            ( MTL.WriterT
-                [BakerConfigureUpdateChange]
-                (MTL.ExceptT BakerConfigureResult m)
-            )
-            (PersistentAccount (AccountVersionFor pv) -> m (PersistentAccount (AccountVersionFor pv)))
-    updateBakerPoolInfo oldBkr cp = do
-        let pu0 = emptyBakerPoolInfoUpdate
-        pu1 <- condPoolInfoUpdate bcuOpenForDelegation (updateOpenForDelegation oldBkr) pu0
-        pu2 <- condPoolInfoUpdate bcuMetadataURL (updateMetadataURL oldBkr) pu1
-        pu3 <- condPoolInfoUpdate bcuTransactionFeeCommission (updateTransactionFeeCommission oldBkr cp) pu2
-        pu4 <- condPoolInfoUpdate bcuBakingRewardCommission (updateBakingRewardCommission oldBkr cp) pu3
-        pu5 <- condPoolInfoUpdate bcuFinalizationRewardCommission (updateFinalizationRewardCommission oldBkr cp) pu4
-        return $ updateAccountBakerPoolInfo pu5
-    condPoolInfoUpdate Nothing _ pu = return pu
-    condPoolInfoUpdate (Just x) a pu = a x pu
-    updateOpenForDelegation oldBkr openForDelegation pu = do
-        MTL.tell [BakerConfigureOpenForDelegation openForDelegation]
-        if oldBkr ^. BaseAccounts.poolOpenStatus == openForDelegation
-            then return pu
-            else do
-                when (openForDelegation == Transactions.ClosedForAll) $ do
-                    -- Transfer all existing delegators to passive delegation.
-                    birkParams <- MTL.gets bspBirkParameters
-                    activeBkrs <- liftBSO $ refLoad (birkParams ^. birkActiveBakers)
-                    -- Update the active bakers
-                    (delegators, newActiveBkrs) <- transferDelegatorsToPassive bid activeBkrs
-                    newActiveBkrsRef <- refMake newActiveBkrs
-                    MTL.modify $ \bsp -> bsp{bspBirkParameters = birkParams & birkActiveBakers .~ newActiveBkrsRef}
-                    -- Update each baker account
-                    accts0 <- MTL.gets bspAccounts
-                    accts1 <- foldM redelegatePassive accts0 delegators
-                    MTL.modify $ \bsp -> bsp{bspAccounts = accts1}
-                return $! pu{updOpenForDelegation = Just openForDelegation}
-    updateMetadataURL oldBkr metadataURL pu = do
-        MTL.tell [BakerConfigureMetadataURL metadataURL]
-        if oldBkr ^. BaseAccounts.poolMetadataUrl == metadataURL
-            then return pu
-            else return $! pu{updMetadataURL = Just metadataURL}
-    updateTransactionFeeCommission oldBkr cp tfc pu = do
-        let range = cp ^. cpPoolParameters . ppCommissionBounds . transactionCommissionRange
-        unless (isInRange tfc range) (MTL.throwError BCTransactionFeeCommissionNotInRange)
-        MTL.tell [BakerConfigureTransactionFeeCommission tfc]
-        if oldBkr ^. BaseAccounts.poolCommissionRates . transactionCommission == tfc
-            then return pu
-            else return $! pu{updTransactionFeeCommission = Just tfc}
-    updateBakingRewardCommission oldBkr cp brc pu = do
-        let range = cp ^. cpPoolParameters . ppCommissionBounds . bakingCommissionRange
-        unless (isInRange brc range) (MTL.throwError BCBakingRewardCommissionNotInRange)
-        MTL.tell [BakerConfigureBakingRewardCommission brc]
-        if oldBkr ^. BaseAccounts.poolCommissionRates . bakingCommission == brc
-            then return pu
-            else return $! pu{updBakingRewardCommission = Just brc}
-    updateFinalizationRewardCommission oldBkr cp frc pu = do
-        let range = cp ^. cpPoolParameters . ppCommissionBounds . finalizationCommissionRange
-        unless (isInRange frc range) (MTL.throwError BCFinalizationRewardCommissionNotInRange)
-        MTL.tell [BakerConfigureFinalizationRewardCommission frc]
-        if oldBkr ^. BaseAccounts.poolCommissionRates . finalizationCommission == frc
-            then return pu
-            else return $! pu{updFinalizationRewardCommission = Just frc}
-    updateCapital ::
-        SBool (SupportsFlexibleCooldown (AccountVersionFor pv)) ->
-        AccountBaker (AccountVersionFor pv) ->
-        ChainParameters' (ChainParametersVersionFor pv) ->
-        PersistentAccount (AccountVersionFor pv) ->
-        MTL.StateT
-            (BlockStatePointers pv)
-            ( MTL.WriterT
-                [BakerConfigureUpdateChange]
-                (MTL.ExceptT BakerConfigureResult m)
-            )
-            ( PersistentAccount (AccountVersionFor pv) ->
-              m (PersistentAccount (AccountVersionFor pv))
-            )
-    updateCapital SFalse oldBkr cp _ = ifPresent bcuCapital $ \capital -> do
-        when (_bakerPendingChange oldBkr /= BaseAccounts.NoChange) (MTL.throwError BCChangePending)
-        let capitalMin = cp ^. cpPoolParameters . ppMinimumEquityCapital
-        let cooldownDuration = cp ^. cpCooldownParameters . cpPoolOwnerCooldown
-            cooldownElapsed = addDurationSeconds bcuSlotTimestamp cooldownDuration
-        if capital == 0
-            then do
-                let bpc = BaseAccounts.RemoveStake (BaseAccounts.PendingChangeEffectiveV1 cooldownElapsed)
-                MTL.tell [BakerConfigureStakeReduced capital]
-                return $ setAccountStakePendingChange bpc
-            else do
-                when (capital < capitalMin) (MTL.throwError BCStakeUnderThreshold)
-                case compare capital (_stakedAmount oldBkr) of
-                    LT -> do
-                        let bpc = BaseAccounts.ReduceStake capital (BaseAccounts.PendingChangeEffectiveV1 cooldownElapsed)
-                        MTL.tell [BakerConfigureStakeReduced capital]
-                        return $ setAccountStakePendingChange bpc
-                    EQ -> do
-                        MTL.tell [BakerConfigureStakeIncreased capital]
-                        return return
-                    GT -> do
-                        birkParams <- MTL.gets bspBirkParameters
-                        activeBkrs <- liftBSO $ refLoad (birkParams ^. birkActiveBakers)
-                        newActiveBkrs <-
-                            liftBSO $
-                                refMake $
-                                    activeBkrs
-                                        & totalActiveCapital
-                                            %~ addActiveCapital (capital - _stakedAmount oldBkr)
-                        MTL.modify' $ \bsp -> bsp{bspBirkParameters = birkParams & birkActiveBakers .~ newActiveBkrs}
-                        MTL.tell [BakerConfigureStakeIncreased capital]
-                        return $ setAccountStake capital
-    updateCapital STrue oldBkr cp acc = ifPresent bcuCapital $ \capital -> do
-        when (_bakerPendingChange oldBkr /= BaseAccounts.NoChange) (MTL.throwError BCChangePending)
-        let capitalMin = cp ^. cpPoolParameters . ppMinimumEquityCapital
-        if capital == 0
-            then do
-                birkParams <- MTL.gets bspBirkParameters
-                activeBkrs <- liftBSO $ refLoad (birkParams ^. birkActiveBakers)
-                (delegators, newActiveBkrs) <- transferDelegatorsToPassive bid activeBkrs
-                newTrie <- Trie.delete bid (newActiveBkrs ^. activeBakers)
-                let newActiveBkrs2 =
-                        newActiveBkrs
-                            & activeBakers .~ newTrie
-                            & totalActiveCapital
-                                %~ subtractActiveCapital (_stakedAmount oldBkr)
-                newActiveBkrsRef <- refMake newActiveBkrs2
-                let notAlreadyInPrePreCooldown = do
-                        accountsInCooldownForPV <- MTL.gets bspAccountsInCooldown
-                        let oldAccountsInCooldown = case theAccountsInCooldownForPV accountsInCooldownForPV of
-                                CTrue accounts -> accounts
-                            oldPrePreCooldowns = _prePreCooldown oldAccountsInCooldown
-                        ppRef <- liftBSO $ refMake $ AccountListItem ai oldPrePreCooldowns
-                        let newPrePreCooldowns = Some ppRef
-                            newAccountsInCooldown =
-                                AccountsInCooldownForPV $
-                                    CTrue
-                                        oldAccountsInCooldown{_prePreCooldown = newPrePreCooldowns}
-                        MTL.modify' $ \bsp ->
-                            bsp
-                                { bspBirkParameters = birkParams & birkActiveBakers .~ newActiveBkrsRef,
-                                  bspAccountsInCooldown = newAccountsInCooldown
-                                }
-                maybeCooldowns <- accountCooldowns acc
-                case maybeCooldowns of
-                    Nothing -> notAlreadyInPrePreCooldown
-                    Just cooldowns -> case CooldownQueue.prePreCooldown cooldowns of
-                        Absent -> notAlreadyInPrePreCooldown
-                        Present _ ->
-                            MTL.modify' $ \bsp ->
-                                bsp
-                                    { bspBirkParameters = birkParams & birkActiveBakers .~ newActiveBkrsRef
-                                    }
-                accts0 <- MTL.gets bspAccounts
-                accts1 <- foldM redelegatePassive accts0 delegators
-                MTL.modify $ \bsp -> bsp{bspAccounts = accts1}
-                MTL.tell [BakerConfigureStakeReduced 0]
-                return $ removeAccountStake >=> addAccountPrePreCooldown (_stakedAmount oldBkr)
-            else do
-                when (capital < capitalMin) (MTL.throwError BCStakeUnderThreshold)
-                case compare capital (_stakedAmount oldBkr) of
-                    LT -> do
-                        birkParams <- MTL.gets bspBirkParameters
-                        activeBkrs <- liftBSO $ refLoad (birkParams ^. birkActiveBakers)
-                        newActiveBkrs <-
-                            liftBSO $
-                                refMake $
-                                    activeBkrs
-                                        & totalActiveCapital
-                                            %~ subtractActiveCapital (_stakedAmount oldBkr - capital)
-                        let notAlreadyInPrePreCooldown = do
-                                accountsInCooldownForPV <- MTL.gets bspAccountsInCooldown
-                                let oldAccountsInCooldown = case theAccountsInCooldownForPV accountsInCooldownForPV of
-                                        CTrue accounts -> accounts
-                                    oldPrePreCooldowns = _prePreCooldown oldAccountsInCooldown
-                                ppRef <- liftBSO $ refMake $ AccountListItem ai oldPrePreCooldowns
-                                let newPrePreCooldowns = Some ppRef
-                                    newAccountsInCooldown =
-                                        AccountsInCooldownForPV $
-                                            CTrue
-                                                oldAccountsInCooldown{_prePreCooldown = newPrePreCooldowns}
-                                MTL.modify' $ \bsp ->
-                                    bsp
-                                        { bspBirkParameters = birkParams & birkActiveBakers .~ newActiveBkrs,
-                                          bspAccountsInCooldown = newAccountsInCooldown
-                                        }
-                        maybeCooldowns <- accountCooldowns acc
-                        case maybeCooldowns of
-                            Nothing -> notAlreadyInPrePreCooldown
-                            Just cooldowns -> case CooldownQueue.prePreCooldown cooldowns of
-                                Absent -> notAlreadyInPrePreCooldown
-                                Present _ ->
-                                    MTL.modify' $ \bsp ->
-                                        bsp
-                                            { bspBirkParameters = birkParams & birkActiveBakers .~ newActiveBkrs
-                                            }
-                        MTL.tell [BakerConfigureStakeReduced capital]
-                        return $ setAccountStake capital >=> addAccountPrePreCooldown (_stakedAmount oldBkr - capital)
-                    EQ -> do
-                        MTL.tell [BakerConfigureStakeIncreased capital]
-                        return return
-                    GT -> do
-                        birkParams <- MTL.gets bspBirkParameters
-                        activeBkrs <- liftBSO $ refLoad (birkParams ^. birkActiveBakers)
-                        newActiveBkrs <-
-                            liftBSO $
-                                refMake $
-                                    activeBkrs
-                                        & totalActiveCapital
-                                            %~ addActiveCapital (capital - _stakedAmount oldBkr)
-                        MTL.modify' $ \bsp -> bsp{bspBirkParameters = birkParams & birkActiveBakers .~ newActiveBkrs}
-                        MTL.tell [BakerConfigureStakeIncreased capital]
-                        return $ setAccountStake capital >=> reactivateCooldownAmount (capital - _stakedAmount oldBkr)
-    maybeReleaseCooldownGlobally ::
-        SBool (SupportsFlexibleCooldown (AccountVersionFor pv)) ->
-        (PersistentAccount (AccountVersionFor pv) -> m (PersistentAccount (AccountVersionFor pv))) ->
-        PersistentAccount (AccountVersionFor pv) ->
-        MTL.StateT
-            (BlockStatePointers pv)
-            ( MTL.WriterT
-                [BakerConfigureUpdateChange]
-                (MTL.ExceptT BakerConfigureResult m)
-            )
-            ()
-    maybeReleaseCooldownGlobally SFalse _ _ = return ()
-    maybeReleaseCooldownGlobally STrue upd acc = do
-        maybeCooldownsBefore <- accountCooldowns acc
-        newAcc <- liftBSO $ upd acc
-        setAccount newAcc
-        maybeCooldownsAfter <- accountCooldowns newAcc
-        let removals = cooldownRemovals maybeCooldownsBefore maybeCooldownsAfter
-        newCooldowns <- applyCooldownRemovalsGlobally ai removals =<< MTL.gets bspAccountsInCooldown
-        MTL.modify' $ \bsp ->
-            bsp
-                { bspAccountsInCooldown = newCooldowns
-                }
-
 doConstrainBakerCommission ::
     (SupportsPersistentState pv m, PVSupportsDelegation pv) =>
     PersistentBlockState pv ->
@@ -2378,48 +1892,19 @@ doConstrainBakerCommission pbs ai ranges = do
     updateFinalizationRewardCommission =
         finalizationCommission %~ (`closestInRange` (ranges ^. finalizationCommissionRange))
 
--- | Checks that the delegation target is not over-delegated.
---  This can throw one of the following 'DelegationConfigureResult's, in order:
+-- | Check the conditions required to successfully add a delegator to an account:
 --
---    * 'DCInvalidDelegationTarget' if the target baker is not a baker.
---    * 'DCPoolStakeOverThreshold' if the delegated amount puts the pool over the leverage bound.
---    * 'DCPoolOverDelegated' if the delegated amount puts the pool over the capital bound.
-delegationConfigureDisallowOverdelegation ::
-    (IsProtocolVersion pv, PVSupportsDelegation pv, MTL.MonadError DelegationConfigureResult m, SupportsPersistentAccount pv m) =>
-    BlockStatePointers pv ->
-    PoolParameters 'ChainParametersV1 ->
-    DelegationTarget ->
-    m ()
-delegationConfigureDisallowOverdelegation bsp poolParams target = case target of
-    Transactions.DelegatePassive -> return ()
-    Transactions.DelegateToBaker bid@(BakerId baid) -> do
-        bakerEquityCapital <-
-            onAccount baid bsp accountBakerStakeAmount >>= \case
-                Just amt -> return amt
-                _ -> MTL.throwError (DCInvalidDelegationTarget bid)
-        capitalTotal <- totalCapital bsp
-        bakerDelegatedCapital <- poolDelegatorCapital bsp bid
-        let PoolCaps{..} = delegatedCapitalCaps poolParams capitalTotal bakerEquityCapital bakerDelegatedCapital
-        when (bakerDelegatedCapital > leverageCap) $ MTL.throwError DCPoolStakeOverThreshold
-        when (bakerDelegatedCapital > boundCap) $ MTL.throwError DCPoolOverDelegated
-
--- | Check that a delegation target is open for delegation.
---  If the target is not a baker, this throws 'DCInvalidDelegationTarget'.
---  If the target is not open for all, this throws 'DCPoolClosed'.
-delegationCheckTargetOpen ::
-    (IsProtocolVersion pv, PVSupportsDelegation pv, MTL.MonadError DelegationConfigureResult m, SupportsPersistentAccount pv m) =>
-    BlockStatePointers pv ->
-    DelegationTarget ->
-    m ()
-delegationCheckTargetOpen _ Transactions.DelegatePassive = return ()
-delegationCheckTargetOpen bsp (Transactions.DelegateToBaker bid@(BakerId baid)) = do
-    onAccount baid bsp accountBaker >>= \case
-        Just baker -> do
-            case baker ^. BaseAccounts.poolOpenStatus of
-                Transactions.OpenForAll -> return ()
-                _ -> MTL.throwError DCPoolClosed
-        _ -> MTL.throwError (DCInvalidDelegationTarget bid)
-
+--      * the delegation target is passive delegation; or
+--
+--      * the delegation target is a baker (otherwise, throw 'DCFInvalidDelegationTarget') and:
+--
+--           - the baker's pool is open for all (otherwise, throw 'DCFPoolClosed'),
+--
+--           - the delegation would not put the pool over the leverage bound (otherwise, throw
+--             'DCFPoolStakeOverThreshold'), and
+--
+--           - the delegation would not put the pool over the capital bound (otherwise, throw
+--             'DCFPoolOverDelegated').
 addDelegatorChecks ::
     ( IsProtocolVersion pv,
       PVSupportsDelegation pv,
@@ -2726,354 +2211,6 @@ newUpdateDelegator pbs blockTimestamp ai du@DelegatorUpdate{..} = do
                 (bspAccountsInCooldown bsp)
         return bsp{bspAccountsInCooldown = newAccountsInCooldown}
 
-doConfigureDelegation ::
-    forall pv m.
-    ( SupportsPersistentState pv m,
-      PVSupportsDelegation pv,
-      IsSupported 'PTTimeParameters (ChainParametersVersionFor pv) ~ 'True,
-      PoolParametersVersionFor (ChainParametersVersionFor pv) ~ 'PoolParametersVersion1,
-      CooldownParametersVersionFor (ChainParametersVersionFor pv) ~ 'CooldownParametersVersion1
-    ) =>
-    PersistentBlockState pv ->
-    AccountIndex ->
-    DelegationConfigure ->
-    m (DelegationConfigureResult, PersistentBlockState pv)
-doConfigureDelegation pbs ai DelegationConfigureAdd{..} = do
-    -- It is assumed here that this account is NOT a baker and NOT a delegator.
-    bsp <- loadPBS pbs
-    poolParams <- _cpPoolParameters <$> lookupCurrentParameters (bspUpdates bsp)
-    result <- MTL.runExceptT $ do
-        newBSP <- updateBlockState (sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv))) bsp
-        delegationConfigureDisallowOverdelegation newBSP poolParams dcaDelegationTarget
-        return newBSP
-    case result of
-        Left e -> return (e, pbs)
-        Right newBirkParams -> (DCSuccess [] did,) <$> storePBS pbs newBirkParams
-  where
-    did = DelegatorId ai
-    updateBlockState ::
-        SBool (SupportsFlexibleCooldown (AccountVersionFor pv)) ->
-        BlockStatePointers pv ->
-        MTL.ExceptT DelegationConfigureResult m (BlockStatePointers pv)
-    updateBlockState SFalse bsp =
-        lift (Accounts.indexedAccount ai (bspAccounts bsp)) >>= \case
-            Nothing -> MTL.throwError DCInvalidAccount
-            Just _ -> do
-                delegationCheckTargetOpen bsp dcaDelegationTarget
-                newBirkParams <- updateBirk bsp dcaDelegationTarget
-                let dlg =
-                        BaseAccounts.AccountDelegationV1
-                            { BaseAccounts._delegationIdentity = did,
-                              BaseAccounts._delegationStakedAmount = dcaCapital,
-                              BaseAccounts._delegationStakeEarnings = dcaRestakeEarnings,
-                              BaseAccounts._delegationTarget = dcaDelegationTarget,
-                              BaseAccounts._delegationPendingChange = BaseAccounts.NoChange
-                            }
-                -- This cannot fail to update the accounts, since we already looked up the accounts:
-                newAccounts <- lift $ Accounts.updateAccountsAtIndex' (addAccountDelegator dlg) ai (bspAccounts bsp)
-                return bsp{bspBirkParameters = newBirkParams, bspAccounts = newAccounts}
-    updateBlockState STrue bsp =
-        lift (Accounts.indexedAccount ai (bspAccounts bsp)) >>= \case
-            Nothing -> MTL.throwError DCInvalidAccount
-            Just acc -> do
-                delegationCheckTargetOpen bsp dcaDelegationTarget
-                newBirkParams <- updateBirk bsp dcaDelegationTarget
-                let dlg =
-                        BaseAccounts.AccountDelegationV1
-                            { BaseAccounts._delegationIdentity = did,
-                              BaseAccounts._delegationStakedAmount = dcaCapital,
-                              BaseAccounts._delegationStakeEarnings = dcaRestakeEarnings,
-                              BaseAccounts._delegationTarget = dcaDelegationTarget,
-                              BaseAccounts._delegationPendingChange = BaseAccounts.NoChange
-                            }
-                maybeCooldownsBefore <- accountCooldowns acc
-                newAcc <- (addAccountDelegator dlg >=> reactivateCooldownAmount dcaCapital) acc
-                maybeCooldownsAfter <- accountCooldowns newAcc
-                -- This cannot fail to update the accounts, since we already looked up the accounts:
-                newAccounts <- lift $ Accounts.setAccountAtIndex ai newAcc (bspAccounts bsp)
-                let removals = cooldownRemovals maybeCooldownsBefore maybeCooldownsAfter
-                newCooldowns <- applyCooldownRemovalsGlobally ai removals (bspAccountsInCooldown bsp)
-                return bsp{bspBirkParameters = newBirkParams, bspAccounts = newAccounts, bspAccountsInCooldown = newCooldowns}
-    updateBirk ::
-        BlockStatePointers pv ->
-        DelegationTarget ->
-        MTL.ExceptT
-            DelegationConfigureResult
-            m
-            (PersistentBirkParameters pv)
-    updateBirk bsp Transactions.DelegatePassive = lift $ do
-        ab <- refLoad (bspBirkParameters bsp ^. birkActiveBakers)
-        let PersistentActiveDelegatorsV1 dset tot = ab ^. passiveDelegators
-        newDset <- Trie.insert did () dset
-        newAB <-
-            refMake
-                ab
-                    { _passiveDelegators = PersistentActiveDelegatorsV1 newDset (tot + dcaCapital),
-                      _totalActiveCapital = addActiveCapital dcaCapital (_totalActiveCapital ab)
-                    }
-        return $! bspBirkParameters bsp & birkActiveBakers .~ newAB
-    updateBirk bsp (Transactions.DelegateToBaker bid) = do
-        pab <- lift $ refLoad (bspBirkParameters bsp ^. birkActiveBakers)
-        mDels <- lift $ Trie.lookup bid (pab ^. activeBakers)
-        case mDels of
-            Nothing -> MTL.throwError (DCInvalidDelegationTarget bid)
-            Just (PersistentActiveDelegatorsV1 dels tot) -> do
-                newDels <- lift $ flip PersistentActiveDelegatorsV1 (tot + dcaCapital) <$> (Trie.insert did () dels)
-                newActiveBakers <- lift $ Trie.insert bid newDels (pab ^. activeBakers)
-                newpabref <- lift $ refMake pab{_activeBakers = newActiveBakers, _totalActiveCapital = addActiveCapital dcaCapital (_totalActiveCapital pab)}
-                return $! bspBirkParameters bsp & birkActiveBakers .~ newpabref
-doConfigureDelegation pbs ai DelegationConfigureUpdate{..} = do
-    origBSP <- loadPBS pbs
-    cp <- lookupCurrentParameters (bspUpdates origBSP)
-    res <- MTL.runExceptT $ MTL.runWriterT $ flip MTL.execStateT origBSP $ do
-        oldTarget <- updateDelegationTarget
-        updateRestakeEarnings
-        oldCapital <- updateCapital (sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv))) cp
-        checkOverdelegation oldCapital oldTarget cp
-    case res of
-        Left errorRes -> return (errorRes, pbs)
-        Right (newBSP, changes) -> (DCSuccess changes did,) <$> storePBS pbs newBSP
-  where
-    did = DelegatorId ai
-    getAccountOrFail = do
-        bsp <- MTL.get
-        Accounts.indexedAccount ai (bspAccounts bsp) >>= \case
-            Nothing -> MTL.throwError DCInvalidAccount
-            Just acc ->
-                accountDelegator acc >>= \case
-                    Just del -> return (del, acc)
-                    Nothing -> MTL.throwError DCInvalidDelegator
-    modifyAccount updAcc = do
-        bsp <- MTL.get
-        newAccounts <- Accounts.updateAccountsAtIndex' updAcc ai (bspAccounts bsp)
-        MTL.put
-            bsp
-                { bspAccounts = newAccounts
-                }
-    setAccount ::
-        PersistentAccount (AccountVersionFor pv) ->
-        MTL.StateT
-            (BlockStatePointers pv)
-            ( MTL.WriterT
-                [DelegationConfigureUpdateChange]
-                (MTL.ExceptT DelegationConfigureResult m)
-            )
-            ()
-    setAccount acc = do
-        bsp <- MTL.get
-        newAccounts <- Accounts.setAccountAtIndex ai acc (bspAccounts bsp)
-        MTL.put
-            bsp
-                { bspAccounts = newAccounts
-                }
-    updateDelegationTarget = do
-        (acctDlg, _) <- getAccountOrFail
-        let oldTarget = acctDlg ^. BaseAccounts.delegationTarget
-        forM_ dcuDelegationTarget $ \target -> do
-            unless (oldTarget == target) $ do
-                -- Check that the target pool is open for delegation
-                bsp0 <- MTL.get
-                delegationCheckTargetOpen bsp0 target
-                ab <- refLoad =<< use (to bspBirkParameters . birkActiveBakers)
-                let stakedAmt = acctDlg ^. BaseAccounts.delegationStakedAmount
-                -- Transfer the delegator in the active bakers from the old target to the new one.
-                -- Note, these functions do not modify the total stake, but this is not being changed
-                -- - just moved.
-                ab1 <- removeDelegator oldTarget did stakedAmt ab
-                ab2 <-
-                    addDelegator target did stakedAmt ab1 >>= \case
-                        Left bid -> MTL.throwError (DCInvalidDelegationTarget bid)
-                        Right ab2 -> return ab2
-                newActiveBakers <- refMake ab2
-                MTL.modify' $ \bsp -> bsp{bspBirkParameters = bspBirkParameters bsp & birkActiveBakers .~ newActiveBakers}
-                -- Update the account with the new delegation target.
-                modifyAccount (setAccountDelegationTarget target)
-            MTL.tell [DelegationConfigureDelegationTarget target]
-        return oldTarget
-    updateRestakeEarnings = forM_ dcuRestakeEarnings $ \restakeEarnings -> do
-        (acctDlg, _) <- getAccountOrFail
-        unless (acctDlg ^. BaseAccounts.delegationStakeEarnings == restakeEarnings) $ do
-            modifyAccount (setAccountRestakeEarnings restakeEarnings)
-        MTL.tell [DelegationConfigureRestakeEarnings restakeEarnings]
-    updateCapital ::
-        SBool (SupportsFlexibleCooldown (AccountVersionFor pv)) ->
-        ChainParameters pv ->
-        MTL.StateT
-            (BlockStatePointers pv)
-            ( MTL.WriterT
-                [DelegationConfigureUpdateChange]
-                (MTL.ExceptT DelegationConfigureResult m)
-            )
-            Amount
-    updateCapital SFalse cp = do
-        (ad, _) <- getAccountOrFail
-        forM_ dcuCapital $ \capital -> do
-            when (BaseAccounts._delegationPendingChange ad /= BaseAccounts.NoChange) (MTL.throwError DCChangePending)
-            -- Cooldown time, used when the change reduces or removes the stake.
-            let cooldownDuration = cp ^. cpCooldownParameters . cpDelegatorCooldown
-                cooldownElapsed = addDurationSeconds dcuSlotTimestamp cooldownDuration
-            if capital == 0
-                then do
-                    let dpc = BaseAccounts.RemoveStake (BaseAccounts.PendingChangeEffectiveV1 cooldownElapsed)
-                    modifyAccount $ setAccountStakePendingChange dpc
-                    MTL.tell [DelegationConfigureStakeReduced capital]
-                else case compare capital (BaseAccounts._delegationStakedAmount ad) of
-                    LT -> do
-                        let dpc = BaseAccounts.ReduceStake capital (BaseAccounts.PendingChangeEffectiveV1 cooldownElapsed)
-                        modifyAccount $ setAccountStakePendingChange dpc
-                        MTL.tell [DelegationConfigureStakeReduced capital]
-                    EQ ->
-                        MTL.tell [DelegationConfigureStakeIncreased capital]
-                    GT -> do
-                        bsp1 <- MTL.get
-                        ab <- refLoad (bspBirkParameters bsp1 ^. birkActiveBakers)
-                        newActiveBakers <- addTotalsInActiveBakers ab ad (capital - BaseAccounts._delegationStakedAmount ad)
-                        MTL.modify' $ \bsp -> bsp{bspBirkParameters = bspBirkParameters bsp1 & birkActiveBakers .~ newActiveBakers}
-                        modifyAccount $ setAccountStake capital
-                        MTL.tell [DelegationConfigureStakeIncreased capital]
-        return $ BaseAccounts._delegationStakedAmount ad
-    updateCapital STrue _ = do
-        (ad, acc) <- getAccountOrFail
-        forM_ dcuCapital $ \capital -> do
-            when (BaseAccounts._delegationPendingChange ad /= BaseAccounts.NoChange) (MTL.throwError DCChangePending)
-            -- Cooldown time, used when the change reduces or removes the stake.
-            if capital == 0
-                then do
-                    bsp1 <- MTL.get
-                    ab <- refLoad (bspBirkParameters bsp1 ^. birkActiveBakers)
-                    newActiveBakers <- removeDelegatorFromActiveBakers ab ad (BaseAccounts._delegationStakedAmount ad - capital)
-                    let notAlreadyInPrePreCooldown = do
-                            accountsInCooldownForPV <- MTL.gets bspAccountsInCooldown
-                            let oldAccountsInCooldown = case theAccountsInCooldownForPV accountsInCooldownForPV of
-                                    CTrue accounts -> accounts
-                                oldPrePreCooldowns = _prePreCooldown oldAccountsInCooldown
-                            ppRef <- refMake $ AccountListItem ai oldPrePreCooldowns
-                            let newPrePreCooldowns = Some ppRef
-                                newAccountsInCooldown =
-                                    AccountsInCooldownForPV $
-                                        CTrue
-                                            oldAccountsInCooldown{_prePreCooldown = newPrePreCooldowns}
-                            MTL.modify' $ \bsp ->
-                                bsp
-                                    { bspBirkParameters = bspBirkParameters bsp1 & birkActiveBakers .~ newActiveBakers,
-                                      bspAccountsInCooldown = newAccountsInCooldown
-                                    }
-                    maybeCooldowns <- accountCooldowns acc
-                    case maybeCooldowns of
-                        Nothing -> notAlreadyInPrePreCooldown
-                        Just cooldowns -> case CooldownQueue.prePreCooldown cooldowns of
-                            Absent -> notAlreadyInPrePreCooldown
-                            Present _ ->
-                                MTL.modify' $ \bsp ->
-                                    bsp
-                                        { bspBirkParameters = bspBirkParameters bsp1 & birkActiveBakers .~ newActiveBakers
-                                        }
-                    modifyAccount $ removeAccountStake >=> addAccountPrePreCooldown (BaseAccounts._delegationStakedAmount ad)
-                    MTL.tell [DelegationConfigureStakeReduced 0]
-                else case compare capital (BaseAccounts._delegationStakedAmount ad) of
-                    LT -> do
-                        bsp1 <- MTL.get
-                        ab <- refLoad (bspBirkParameters bsp1 ^. birkActiveBakers)
-                        newActiveBakers <- subtractTotalsInActiveBakers ab ad (BaseAccounts._delegationStakedAmount ad - capital)
-                        let notAlreadyInPrePreCooldown = do
-                                accountsInCooldownForPV <- MTL.gets bspAccountsInCooldown
-                                let oldAccountsInCooldown = case theAccountsInCooldownForPV accountsInCooldownForPV of
-                                        CTrue accounts -> accounts
-                                    oldPrePreCooldowns = _prePreCooldown oldAccountsInCooldown
-                                ppRef <- refMake $ AccountListItem ai oldPrePreCooldowns
-                                let newPrePreCooldowns = Some ppRef
-                                    newAccountsInCooldown =
-                                        AccountsInCooldownForPV $
-                                            CTrue
-                                                oldAccountsInCooldown{_prePreCooldown = newPrePreCooldowns}
-                                MTL.modify' $ \bsp ->
-                                    bsp
-                                        { bspBirkParameters = bspBirkParameters bsp1 & birkActiveBakers .~ newActiveBakers,
-                                          bspAccountsInCooldown = newAccountsInCooldown
-                                        }
-                        maybeCooldowns <- accountCooldowns acc
-                        case maybeCooldowns of
-                            Nothing -> notAlreadyInPrePreCooldown
-                            Just cooldowns -> case CooldownQueue.prePreCooldown cooldowns of
-                                Absent -> notAlreadyInPrePreCooldown
-                                Present _ ->
-                                    MTL.modify' $ \bsp ->
-                                        bsp
-                                            { bspBirkParameters = bspBirkParameters bsp1 & birkActiveBakers .~ newActiveBakers
-                                            }
-                        modifyAccount $ setAccountStake capital >=> addAccountPrePreCooldown (BaseAccounts._delegationStakedAmount ad - capital)
-                        MTL.tell [DelegationConfigureStakeReduced capital]
-                    EQ ->
-                        MTL.tell [DelegationConfigureStakeIncreased capital]
-                    GT -> do
-                        bsp1 <- MTL.get
-                        ab <- refLoad (bspBirkParameters bsp1 ^. birkActiveBakers)
-                        newActiveBakers <- addTotalsInActiveBakers ab ad (capital - BaseAccounts._delegationStakedAmount ad)
-                        maybeCooldownsBefore <- accountCooldowns acc
-                        let accUpd = setAccountStake capital >=> reactivateCooldownAmount (capital - BaseAccounts._delegationStakedAmount ad)
-                        newAcc <- accUpd acc
-                        setAccount newAcc
-                        maybeCooldownsAfter <- accountCooldowns newAcc
-                        let removals = cooldownRemovals maybeCooldownsBefore maybeCooldownsAfter
-                        newCooldowns <- applyCooldownRemovalsGlobally ai removals (bspAccountsInCooldown bsp1)
-                        MTL.modify' $ \bsp ->
-                            bsp
-                                { bspBirkParameters = bspBirkParameters bsp1 & birkActiveBakers .~ newActiveBakers,
-                                  bspAccountsInCooldown = newCooldowns
-                                }
-                        MTL.tell [DelegationConfigureStakeIncreased capital]
-        return $ BaseAccounts._delegationStakedAmount ad
-    addTotalsInActiveBakers ab0 ad delta = do
-        let ab1 = ab0 & totalActiveCapital %~ addActiveCapital delta
-        case ad ^. BaseAccounts.delegationTarget of
-            Transactions.DelegatePassive -> do
-                let PersistentActiveDelegatorsV1 dset dtot = ab1 ^. passiveDelegators
-                refMake $! ab1 & passiveDelegators .~ PersistentActiveDelegatorsV1 dset (dtot + delta)
-            Transactions.DelegateToBaker bid -> do
-                Trie.lookup bid (ab1 ^. activeBakers) >>= \case
-                    Nothing -> error "Invariant violation: delegation target is not an active baker"
-                    Just (PersistentActiveDelegatorsV1 dset dtot) -> do
-                        newActiveMap <- Trie.insert bid (PersistentActiveDelegatorsV1 dset (dtot + delta)) (ab1 ^. activeBakers)
-                        refMake $! ab1 & activeBakers .~ newActiveMap
-    subtractTotalsInActiveBakers ab0 ad delta = do
-        let ab1 = ab0 & totalActiveCapital %~ subtractActiveCapital delta
-        case ad ^. BaseAccounts.delegationTarget of
-            Transactions.DelegatePassive -> do
-                let PersistentActiveDelegatorsV1 dset dtot = ab1 ^. passiveDelegators
-                refMake $! ab1 & passiveDelegators .~ PersistentActiveDelegatorsV1 dset (dtot - delta)
-            Transactions.DelegateToBaker bid -> do
-                Trie.lookup bid (ab1 ^. activeBakers) >>= \case
-                    Nothing -> error "Invariant violation: delegation target is not an active baker"
-                    Just (PersistentActiveDelegatorsV1 dset dtot) -> do
-                        newActiveMap <- Trie.insert bid (PersistentActiveDelegatorsV1 dset (dtot - delta)) (ab1 ^. activeBakers)
-                        refMake $! ab1 & activeBakers .~ newActiveMap
-    removeDelegatorFromActiveBakers ab0 ad delta = do
-        let ab1 = ab0 & totalActiveCapital %~ subtractActiveCapital delta
-        case ad ^. BaseAccounts.delegationTarget of
-            Transactions.DelegatePassive -> do
-                let PersistentActiveDelegatorsV1 dset dtot = ab1 ^. passiveDelegators
-                newDelegatorSet <- Trie.delete (ad ^. BaseAccounts.delegationIdentity) dset
-                refMake $! ab1 & passiveDelegators .~ PersistentActiveDelegatorsV1 newDelegatorSet (dtot - delta)
-            Transactions.DelegateToBaker bid -> do
-                Trie.lookup bid (ab1 ^. activeBakers) >>= \case
-                    Nothing -> error "Invariant violation: delegation target is not an active baker"
-                    Just (PersistentActiveDelegatorsV1 dset dtot) -> do
-                        newDelegatorSet <- Trie.delete (ad ^. BaseAccounts.delegationIdentity) dset
-                        newActiveMap <- Trie.insert bid (PersistentActiveDelegatorsV1 newDelegatorSet (dtot - delta)) (ab1 ^. activeBakers)
-                        refMake $! ab1 & activeBakers .~ newActiveMap
-    checkOverdelegation oldCapital oldTarget cp = do
-        let doCheckOverDelegation = do
-                let pp = cp ^. cpPoolParameters
-                (ad, _) <- getAccountOrFail
-                let target = ad ^. BaseAccounts.delegationTarget
-                bsp <- MTL.get
-                delegationConfigureDisallowOverdelegation bsp pp target
-        case (dcuCapital, dcuDelegationTarget) of
-            (Just newCapital, Just newTarget) -> unless (newCapital <= oldCapital && newTarget == oldTarget) doCheckOverDelegation
-            (Just newCapital, Nothing) -> unless (newCapital <= oldCapital) doCheckOverDelegation
-            (Nothing, Just newTarget) -> unless (newTarget == oldTarget) doCheckOverDelegation
-            _ -> return ()
-
 data CooldownRemovals = CooldownRemovals
     { -- | Whether the pre-pre cooldown was removed.
       crPrePreCooldown :: Bool,
@@ -4816,15 +3953,11 @@ instance (IsProtocolVersion pv, PersistentState av pv r m) => BlockStateOperatio
     bsoGetCurrentEpochFullBakersEx = doGetCurrentEpochFullBakersEx
     bsoGetCurrentCapitalDistribution = doGetCurrentCapitalDistribution
     bsoAddBaker = doAddBaker
-    bsoConfigureBaker = case delegationChainParameters @pv of
-        DelegationChainParameters -> doConfigureBaker
     bsoAddValidator = case delegationChainParameters @pv of
         DelegationChainParameters -> \bs ai a -> MTL.runExceptT (newAddValidator bs ai a)
     bsoUpdateValidator = case delegationChainParameters @pv of
         DelegationChainParameters -> \bs ts ai u -> MTL.runExceptT (newUpdateValidator bs ts ai u)
     bsoConstrainBakerCommission = doConstrainBakerCommission
-    bsoConfigureDelegation = case delegationChainParameters @pv of
-        DelegationChainParameters -> doConfigureDelegation
     bsoAddDelegator = case delegationChainParameters @pv of
         DelegationChainParameters -> \bs ai a -> MTL.runExceptT (newAddDelegator bs ai a)
     bsoUpdateDelegator = case delegationChainParameters @pv of
diff --git a/concordium-consensus/tests/globalstate/GlobalStateTests/Updates.hs b/concordium-consensus/tests/globalstate/GlobalStateTests/Updates.hs
index 3749a6887..4c095ac77 100644
--- a/concordium-consensus/tests/globalstate/GlobalStateTests/Updates.hs
+++ b/concordium-consensus/tests/globalstate/GlobalStateTests/Updates.hs
@@ -123,42 +123,50 @@ createAccountWith a bs = do
     (,accIndex) <$> bsoModifyAccount bs' (emptyAccountUpdate accIndex & auAmount ?~ a)
 
 -- | Add a baker with the given staked amount.
-addBakerWith :: Amount -> (PBS.PersistentBlockState PV, AccountIndex) -> ThisMonadConcrete PV (BakerConfigureResult, (PBS.PersistentBlockState PV, AccountIndex))
+addBakerWith ::
+    Amount ->
+    (PBS.PersistentBlockState PV, AccountIndex) ->
+    ThisMonadConcrete PV (Either ValidatorConfigureFailure (PBS.PersistentBlockState PV, AccountIndex))
 addBakerWith am (bs, ai) = do
     a <- BlockSig.verifyKey <$> liftIO BlockSig.newKeyPair
     b <- Bls.derivePublicKey <$> liftIO Bls.generateSecretKey
     c <- VRF.publicKey <$> liftIO VRF.newKeyPair
     let conf =
-            BakerConfigureAdd
-                { bcaKeys = BakerKeyUpdate a b c,
-                  bcaCapital = am,
-                  bcaRestakeEarnings = False,
-                  bcaOpenForDelegation = ClosedForAll,
-                  bcaMetadataURL = emptyUrlText,
-                  bcaTransactionFeeCommission = makeAmountFraction 0,
-                  bcaBakingRewardCommission = makeAmountFraction 0,
-                  bcaFinalizationRewardCommission = makeAmountFraction 0
+            ValidatorAdd
+                { vaKeys = BakerKeyUpdate a b c,
+                  vaCapital = am,
+                  vaRestakeEarnings = False,
+                  vaOpenForDelegation = ClosedForAll,
+                  vaMetadataURL = emptyUrlText,
+                  vaCommissionRates =
+                    CommissionRates
+                        { _transactionCommission = makeAmountFraction 0,
+                          _finalizationCommission = makeAmountFraction 0,
+                          _bakingCommission = makeAmountFraction 0
+                        }
                 }
-    (bar, bs') <- bsoConfigureBaker bs ai conf
-    return (bar, (bs', ai))
+    res <- bsoAddValidator bs ai conf
+    return ((,ai) <$> res)
 
 -- | Modify the staked amount to the given value.
-modifyStakeTo :: Amount -> (PBS.PersistentBlockState PV, AccountIndex) -> ThisMonadConcrete PV (BakerConfigureResult, (PBS.PersistentBlockState PV, AccountIndex))
+modifyStakeTo ::
+    Amount ->
+    (PBS.PersistentBlockState PV, AccountIndex) ->
+    ThisMonadConcrete PV (Either ValidatorConfigureFailure ([BakerConfigureUpdateChange], (PBS.PersistentBlockState PV, AccountIndex)))
 modifyStakeTo a (bs, ai) = do
     let conf =
-            BakerConfigureUpdate
-                { bcuSlotTimestamp = 0,
-                  bcuKeys = Nothing,
-                  bcuCapital = Just a,
-                  bcuRestakeEarnings = Nothing,
-                  bcuOpenForDelegation = Nothing,
-                  bcuMetadataURL = Nothing,
-                  bcuTransactionFeeCommission = Nothing,
-                  bcuBakingRewardCommission = Nothing,
-                  bcuFinalizationRewardCommission = Nothing
+            ValidatorUpdate
+                { vuKeys = Nothing,
+                  vuCapital = Just a,
+                  vuRestakeEarnings = Nothing,
+                  vuOpenForDelegation = Nothing,
+                  vuMetadataURL = Nothing,
+                  vuTransactionFeeCommission = Nothing,
+                  vuBakingRewardCommission = Nothing,
+                  vuFinalizationRewardCommission = Nothing
                 }
-    (bsur, bs') <- bsoConfigureBaker bs ai conf
-    return (bsur, (bs', ai))
+    res <- bsoUpdateValidator bs 0 ai conf
+    return (fmap (,ai) <$> res)
 
 -- | Increase the current threshold for baking. This uses some trickery to run a
 --  side monad that will be a MonadBlobStore that can retrieve the required
@@ -191,19 +199,20 @@ testing1 :: ThisMonadConcrete PV ()
 -- starting from an empty blockstate with the dummy parameters, try to register
 -- a baker with not enough stake. (MUST FAIL)
 testing1 = do
-    (res, _) <-
+    res <-
         createGS
             >>= createAccountWith (limitDelta `div` 2)
             >>= addBakerWith (limit `div` 2)
     case res of
-        BCStakeUnderThreshold -> return ()
-        e -> error $ "Got (" ++ show e ++ ") but wanted BCStakeUnderThreshold"
+        Left VCFStakeUnderThreshold -> return ()
+        Left e -> error $ "Got (" ++ show e ++ ") but wanted VCFStakeUnderThreshold"
+        Right _ -> error "Expected failure, but got success"
 
 -- starting from an empty blockstate with the dummy parameters, register a baker
 -- with enough stake and decrease the stake below the limit. (MUST FAIL)
 testing2'1 :: ThisMonadConcrete PV ()
 testing2'1 = do
-    (res, _) <-
+    res <-
         createGS
             >>= createAccountWith limitDelta
             >>= addBakerWith limit
@@ -214,17 +223,18 @@ testing2'1 = do
                 -- \* the account is not a delegator;
                 -- \* the account has sufficient balance to cover the stake,
                 -- @(BCSuccess [], _)@ is returned, see `bsoConfigureBaker`.
-                (BCSuccess _ _, a) -> modifyStakeTo (limit - 1) a
-                t -> return t
+                Right a -> modifyStakeTo (limit - 1) a
+                Left e -> error $ "Unexpected failure when adding baker: " ++ show e
     case res of
-        BCStakeUnderThreshold -> return ()
-        e -> error $ "Got (" ++ show e ++ ") but wanted BCStakeUnderThreshold"
+        Left VCFStakeUnderThreshold -> return ()
+        Left e -> error $ "Got (" ++ show e ++ ") but wanted VCFStakeUnderThreshold"
+        Right _ -> error "Expected VCFStakeUnderThreshold, but got success"
 
 -- starting from an empty blockstate with the dummy parameters, register a baker
 -- with enough stake and decrease the stake above the limit. (MUST SUCCEED)
 testing2'2 :: ThisMonadConcrete PV ()
 testing2'2 = do
-    (res, _) <-
+    res <-
         createGS
             >>= createAccountWith (limitDelta + 100)
             >>= addBakerWith (limit + 100)
@@ -235,17 +245,18 @@ testing2'2 = do
                 -- \* the account is not a delegator;
                 -- \* the account has sufficient balance to cover the stake,
                 -- @(BCSuccess [], _)@ is returned, see `bsoConfigureBaker`.
-                (BCSuccess _ _, a) -> modifyStakeTo limit a
-                _ -> error "result of modifyStakeTo should be BCSuccess"
+                Right a -> modifyStakeTo limit a
+                Left e -> error $ "Unexpected failure when adding baker: " ++ show e
     case res of
-        BCSuccess [BakerConfigureStakeReduced newStake] _ -> liftIO (assertEqual "new stake" limit newStake)
-        e -> error $ "Got (" ++ show e ++ ") but wanted BakerConfigureStakeReduced"
+        Right ([BakerConfigureStakeReduced newStake], _) -> liftIO (assertEqual "new stake" limit newStake)
+        Right (evts, _) -> error $ "Got " ++ show evts ++ " but wanted BakerConfigureStakeReduced"
+        Left e -> error $ "Got (" ++ show e ++ ") but wanted BakerConfigureStakeReduced"
 
 -- starting from an empty blockstate with the dummy parameters, register a baker
 -- with enough stake and increase the stake. (MUST SUCCEED)
 testing2'3 :: ThisMonadConcrete PV ()
 testing2'3 = do
-    (res, _) <-
+    res <-
         createGS
             >>= createAccountWith (limitDelta + 100)
             >>= addBakerWith limit
@@ -256,18 +267,19 @@ testing2'3 = do
                 -- \* the account is not a delegator;
                 -- \* the account has sufficient balance to cover the stake,
                 -- @(BCSuccess [], _)@ is returned, see `bsoConfigureBaker`.
-                (BCSuccess _ _, a) -> modifyStakeTo (limit + 100) a
-                _ -> error "result of modifyStakeTo should be BCSuccess"
+                Right a -> modifyStakeTo (limit + 100) a
+                Left e -> error $ "Unexpected failure when adding baker: " ++ show e
     case res of
-        BCSuccess [BakerConfigureStakeIncreased newAmount] _ -> liftIO (assertEqual "new stake" (limit + 100) newAmount)
-        e -> error $ "Got (" ++ show e ++ ") but wanted BakerConfigureStakeIncreased"
+        Right ([BakerConfigureStakeIncreased newAmount], _) -> liftIO (assertEqual "new stake" (limit + 100) newAmount)
+        Right (evts, _) -> error $ "Got " ++ show evts ++ " but wanted BakerConfigureStakeIncreased"
+        Left e -> error $ "Got (" ++ show e ++ ") but wanted BakerConfigureStakeIncreased"
 
 -- starting from an empty blockstate with the dummy parameters, register a baker
 -- with enough stake, increase the limit and decrease the stake any amount (MUST
 -- FAIL)
 testing3'1 :: ThisMonadConcrete PV ()
 testing3'1 = do
-    (res, _) <-
+    res <-
         createGS
             >>= createAccountWith limitDelta
             >>= addBakerWith limit
@@ -278,13 +290,14 @@ testing3'1 = do
                     -- \* the account is not a delegator;
                     -- \* the account has sufficient balance to cover the stake,
                     -- @(BCSuccess [], _)@ is returned, see `bsoConfigureBaker`.
-                    (BCSuccess _ _, a) -> increaseLimit (limit * 2) a
-                    (_, bsAccIdx) -> return bsAccIdx
+                    Right a -> increaseLimit (limit * 2) a
+                    Left e -> error $ "Unexpected failure when adding baker: " ++ show e
                 )
             >>= modifyStakeTo (limit - 1)
     case res of
-        BCStakeUnderThreshold -> return ()
-        e -> error $ "Got (" ++ show e ++ ") but wanted BCStakeUnderThreshold"
+        Left VCFStakeUnderThreshold -> return ()
+        Left e -> error $ "Got (" ++ show e ++ ") but wanted VCFStakeUnderThreshold"
+        Right _ -> error "Expected VCFStakeUnderThreshold, but got success"
 
 -- starting from an empty blockstate with the dummy parameters, register a baker
 -- with enough stake, increase the limit and increase the stake below limit
@@ -292,7 +305,7 @@ testing3'1 = do
 -- Note, this is a departure from the behaviour prior to P4, where this would succeed.
 testing3'2 :: ThisMonadConcrete PV ()
 testing3'2 = do
-    (res, _) <-
+    res <-
         createGS
             >>= createAccountWith limitDelta
             >>= addBakerWith limit
@@ -303,20 +316,21 @@ testing3'2 = do
                     -- \* the account is not a delegator;
                     -- \* the account has sufficient balance to cover the stake,
                     -- @(BCSuccess [], _)@ is returned, see `bsoConfigureBaker`.
-                    (BCSuccess _ _, a) -> increaseLimit (limit * 2) a
-                    (_, bsAccIdx) -> return bsAccIdx
+                    Right a -> increaseLimit (limit * 2) a
+                    Left e -> error $ "Unexpected failure when adding baker: " ++ show e
                 )
             >>= modifyStakeTo (limit + 1)
     case res of
-        BCStakeUnderThreshold -> return ()
-        e -> error $ "Got (" ++ show e ++ ") but wanted BCStakeUnderThreshold"
+        Left VCFStakeUnderThreshold -> return ()
+        Left e -> error $ "Got (" ++ show e ++ ") but wanted VCFStakeUnderThreshold"
+        Right _ -> error "Expected VCFStakeUnderThreshold, but got success"
 
 -- starting from an empty blockstate with the dummy parameters, register a baker
 -- with enough stake, increase the limit and increase the stake over limit (MUST
 -- SUCCEED)
 testing3'3 :: ThisMonadConcrete PV ()
 testing3'3 = do
-    (res, _) <-
+    res <-
         createGS
             >>= createAccountWith limitDelta
             >>= addBakerWith limit
@@ -327,13 +341,14 @@ testing3'3 = do
                     -- \* the account is not a delegator;
                     -- \* the account has sufficient balance to cover the stake,
                     -- @(BCSuccess [], _)@ is returned, see `bsoConfigureBaker`.
-                    (BCSuccess _ _, a) -> increaseLimit (limit * 2) a
-                    _ -> error "result of increaseLimit should be BCSuccess"
+                    Right a -> increaseLimit (limit * 2) a
+                    Left e -> error $ "Unexpected failure when adding baker: " ++ show e
                 )
             >>= modifyStakeTo (limit * 2 + 1)
     case res of
-        BCSuccess [BakerConfigureStakeIncreased newStake] _ -> liftIO (assertEqual "new stake" (limit * 2 + 1) newStake)
-        e -> error $ "Got (" ++ show e ++ ") but wanted BakerConfigureStakeIncreased"
+        Right ([BakerConfigureStakeIncreased newStake], _) -> liftIO (assertEqual "new stake" (limit * 2 + 1) newStake)
+        Right (evts, _) -> error $ "Got " ++ show evts ++ " but wanted BakerConfigureStakeIncreased"
+        Left e -> error $ "Got (" ++ show e ++ ") but wanted BakerConfigureStakeIncreased"
 
 tests :: Spec
 tests = do

From fafa769ac07678e74617e2bfa8d8bd9c60cabb63 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Fri, 26 Jul 2024 15:58:59 +0200
Subject: [PATCH 40/81] Simplify the basic blockstate representation of account
 cooldown queues.

---
 .../GlobalState/Basic/BlockState/Account.hs   |  13 +-
 .../Basic/BlockState/CooldownQueue.hs         | 113 ------------------
 .../Persistent/Account/CooldownQueue.hs       |  27 +++--
 .../Persistent/Account/StructureV0.hs         |   3 +-
 .../Persistent/Account/StructureV1.hs         |   2 +-
 .../AccountsMigrationP6ToP7.hs                |  10 +-
 6 files changed, 36 insertions(+), 132 deletions(-)
 delete mode 100644 concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/CooldownQueue.hs

diff --git a/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/Account.hs b/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/Account.hs
index 3e88dfd1b..07492d891 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/Account.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/Account.hs
@@ -22,13 +22,14 @@ import Lens.Micro.Platform
 import qualified Concordium.Crypto.SHA256 as Hash
 import Concordium.GlobalState.Account
 import Concordium.GlobalState.Basic.BlockState.AccountReleaseSchedule
-import Concordium.GlobalState.Basic.BlockState.CooldownQueue
+import Concordium.GlobalState.CooldownQueue
 import Concordium.ID.Parameters
 import Concordium.ID.Types
 import Concordium.Types.HashableTo
 
 import Concordium.Types
 import Concordium.Types.Accounts
+import Concordium.Types.Conditionally
 
 -- | Type for how a 'PersistingAccountData' value is stored as part of
 --  an account. This is stored with its hash.
@@ -57,7 +58,7 @@ data Account (av :: AccountVersion) = Account
       -- | The baker or delegation associated with the account (if any).
       _accountStaking :: !(AccountStake av),
       -- | The cooldown on the account.
-      _accountStakeCooldown :: !(CooldownQueue av)
+      _accountStakeCooldown :: !(Conditionally (SupportsFlexibleCooldown av) Cooldowns)
     }
     deriving (Eq, Show)
 
@@ -150,7 +151,7 @@ accountHashInputsV3 Account{..} =
               amhi3AccountStakeHash = getHash _accountStaking :: AccountStakeHash 'AccountV3,
               amhi3EncryptedAmountHash = getHash _accountEncryptedAmount,
               amhi3AccountReleaseScheduleHash = getHash _accountReleaseSchedule,
-              amhi3Cooldown = getHash _accountStakeCooldown
+              amhi3Cooldown = CooldownQueueHash $ getHash $ uncond _accountStakeCooldown
             }
 
 instance (IsAccountVersion av) => HashableTo (AccountHash av) (Account av) where
@@ -163,6 +164,10 @@ instance (IsAccountVersion av) => HashableTo (AccountHash av) (Account av) where
 instance forall av. (IsAccountVersion av) => HashableTo Hash.Hash (Account av) where
     getHash = coerce @(AccountHash av) . getHash
 
+-- | An empty cooldown queue for a given account version.
+emptyCooldownQueue :: SAccountVersion av -> Conditionally (SupportsFlexibleCooldown av) Cooldowns
+emptyCooldownQueue sav = conditionally (sSupportsFlexibleCooldown sav) emptyCooldowns
+
 -- | Create an empty account with the given public key, address and credentials.
 newAccountMultiCredential ::
     forall av.
@@ -192,7 +197,7 @@ newAccountMultiCredential cryptoParams threshold _accountAddress cs =
           _accountEncryptedAmount = initialAccountEncryptedAmount,
           _accountReleaseSchedule = emptyAccountReleaseSchedule,
           _accountStaking = AccountStakeNone,
-          _accountStakeCooldown = emptyCooldownQueue
+          _accountStakeCooldown = emptyCooldownQueue (accountVersion @av)
         }
 
 -- | Create an empty account with the given public key, address and credential.
diff --git a/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/CooldownQueue.hs b/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/CooldownQueue.hs
deleted file mode 100644
index e2f1a9a6f..000000000
--- a/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/CooldownQueue.hs
+++ /dev/null
@@ -1,113 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE KindSignatures #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TypeApplications #-}
-
-module Concordium.GlobalState.Basic.BlockState.CooldownQueue where
-
-import Data.Bool.Singletons
-import qualified Data.Map.Strict as Map
-import Data.Maybe
-import Data.Serialize
-
-import Concordium.Types
-import Concordium.Types.HashableTo
-
-import Concordium.GlobalState.Account
-import Concordium.GlobalState.CooldownQueue
-import Concordium.Types.Option
-
--- | A 'CooldownQueue' records the inactive stake amounts that are due to be released in future.
---  Note that prior to account version 3 (protocol version 7), the only value is the empty cooldown
---  queue.
-data CooldownQueue (av :: AccountVersion) where
-    -- | The empty cooldown queue.
-    EmptyCooldownQueue :: CooldownQueue av
-    -- | A non-empty cooldown queue.
-    --  INVARIANT: The 'Cooldowns' must not satisfy 'isEmptyCooldowns'.
-    CooldownQueue ::
-        (AVSupportsFlexibleCooldown av) =>
-        !Cooldowns ->
-        CooldownQueue av
-
-deriving instance Show (CooldownQueue av)
-deriving instance Eq (CooldownQueue av)
-
-instance forall av. (IsAccountVersion av) => Serialize (CooldownQueue av) where
-    put = case sSupportsFlexibleCooldown (accountVersion @av) of
-        SFalse -> const (return ())
-        STrue -> \case
-            EmptyCooldownQueue -> putWord64be 0
-            CooldownQueue queue -> put queue
-    get = case sSupportsFlexibleCooldown (accountVersion @av) of
-        SFalse -> return EmptyCooldownQueue
-        STrue -> do
-            cooldowns <- get
-            return $!
-                if isEmptyCooldowns cooldowns
-                    then EmptyCooldownQueue
-                    else CooldownQueue cooldowns
-
-instance HashableTo (CooldownQueueHash av) (CooldownQueue av) where
-    getHash _ = undefined -- FIXME: Define
-
--- | The empty 'CooldownQueue'.
-emptyCooldownQueue :: CooldownQueue av
-emptyCooldownQueue = EmptyCooldownQueue
-
--- | Check if a 'CooldownQueue' is empty.
-isCooldownQueueEmpty :: CooldownQueue av -> Bool
-isCooldownQueueEmpty EmptyCooldownQueue = True
-isCooldownQueueEmpty _ = False
-
--- | Convert a 'Cooldowns' to a 'CooldownQueue', using 'EmptyCooldownQueue' for the case where
---  there are no cooldowns.
-fromCooldowns :: (AVSupportsFlexibleCooldown av) => Cooldowns -> CooldownQueue av
-fromCooldowns cooldowns
-    | isEmptyCooldowns cooldowns = emptyCooldownQueue
-    | otherwise = CooldownQueue cooldowns
-
--- | Create an initial 'CooldownQueue' with only the given target amount set for pre-pre-cooldown.
-initialPrePreCooldownQueue :: (AVSupportsFlexibleCooldown av) => Amount -> CooldownQueue av
-initialPrePreCooldownQueue target =
-    CooldownQueue $
-        Cooldowns
-            { inCooldown = Map.empty,
-              preCooldown = Absent,
-              prePreCooldown = Present target
-            }
-
--- | Process all cooldowns that expire at or before the given timestamp.
---  If there are no such cooldowns, then 'Nothing' is returned.
---  Otherwise, the total amount exiting cooldown and the remaining queue are returned.
-processCooldowns :: Timestamp -> CooldownQueue av -> Maybe (Amount, CooldownQueue av)
-processCooldowns _ EmptyCooldownQueue = Nothing
-processCooldowns ts (CooldownQueue queue)
-    | freeAmount == 0 = Nothing
-    | otherwise = Just (freeAmount, remainder)
-  where
-    freeAmount = sum free + sum bonus
-    (free, bonus, keep) = Map.splitLookup ts (inCooldown queue)
-    remainder = fromCooldowns (queue{inCooldown = keep})
-
--- | Process the pre-cooldown (if any). Any pre-cooldown amount is added to the cooldown queue
---  with the specified expiry time.
-processPreCooldown ::
-    -- | Timestamp at which the cooldown should expire.
-    Timestamp ->
-    -- | Current cooldown queue.
-    CooldownQueue av ->
-    -- | If a change is required, the new cooldown queue.
-    Maybe (CooldownQueue av)
-processPreCooldown _ EmptyCooldownQueue = Nothing
-processPreCooldown _ (CooldownQueue Cooldowns{preCooldown = Absent}) = Nothing
-processPreCooldown ts (CooldownQueue cdns@Cooldowns{preCooldown = Present newCooldownAmt, ..}) =
-    Just $
-        CooldownQueue $
-            cdns
-                { preCooldown = Absent,
-                  inCooldown = Map.alter (Just . (newCooldownAmt +) . fromMaybe 0) ts inCooldown
-                }
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/CooldownQueue.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/CooldownQueue.hs
index 00323d322..44a1f284b 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/CooldownQueue.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/CooldownQueue.hs
@@ -14,14 +14,14 @@ import Data.Functor
 import qualified Data.Map.Strict as Map
 
 import Concordium.Types
+import Concordium.Types.Conditionally
 import Concordium.Types.HashableTo
+import Concordium.Types.Option
 import Concordium.Utils
 
 import Concordium.GlobalState.Account
-import qualified Concordium.GlobalState.Basic.BlockState.CooldownQueue as Transient
 import Concordium.GlobalState.CooldownQueue as Cooldowns
 import Concordium.GlobalState.Persistent.BlobStore
-import Concordium.Types.Option
 
 -- | A 'CooldownQueue' records the inactive stake amounts that are due to be released in future.
 --  Note that prior to account version 3 (protocol version 7), the only value is the empty cooldown
@@ -86,17 +86,26 @@ makeCooldownQueue cooldowns
     | isEmptyCooldowns cooldowns = return EmptyCooldownQueue
     | otherwise = CooldownQueue <$> refMake cooldowns
 
+-- | Construct a 'CooldownQueue' from the representation used for transient accounts.
 makePersistentCooldownQueue ::
     (MonadBlobStore m) =>
-    Transient.CooldownQueue av ->
+    Conditionally (SupportsFlexibleCooldown av) Cooldowns ->
     m (CooldownQueue av)
-makePersistentCooldownQueue Transient.EmptyCooldownQueue = return EmptyCooldownQueue
-makePersistentCooldownQueue (Transient.CooldownQueue queue) = CooldownQueue <$> refMake queue
+makePersistentCooldownQueue CFalse = return EmptyCooldownQueue
+makePersistentCooldownQueue (CTrue cooldowns) = makeCooldownQueue cooldowns
 
-toTransientCooldownQueue :: CooldownQueue av -> Transient.CooldownQueue av
-toTransientCooldownQueue EmptyCooldownQueue = Transient.EmptyCooldownQueue
-toTransientCooldownQueue (CooldownQueue queueRef) =
-    Transient.CooldownQueue (eagerBufferedDeref queueRef)
+-- | Convert a 'CooldownQueue' to representation used for transient accounts.
+toTransientCooldownQueue ::
+    forall av.
+    (IsAccountVersion av) =>
+    CooldownQueue av ->
+    Conditionally (SupportsFlexibleCooldown av) Cooldowns
+toTransientCooldownQueue = case sSupportsFlexibleCooldown (accountVersion @av) of
+    SFalse -> const CFalse
+    STrue ->
+        CTrue . \case
+            EmptyCooldownQueue -> emptyCooldowns
+            CooldownQueue ref -> eagerBufferedDeref ref
 
 -- | Create an initial 'CooldownQueue' with only the given amount set in pre-pre-cooldown.
 initialPrePreCooldownQueue ::
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV0.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV0.hs
index c702af69c..753125202 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV0.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV0.hs
@@ -43,7 +43,6 @@ import Concordium.GlobalState.BakerInfo (BakerAdd (..), BakerKeyUpdate (..), bak
 import qualified Concordium.GlobalState.Basic.BlockState.Account as Transient
 import qualified Concordium.GlobalState.Basic.BlockState.AccountReleaseSchedule as Transient
 import qualified Concordium.GlobalState.Basic.BlockState.AccountReleaseScheduleV0 as ARSV0
-import qualified Concordium.GlobalState.Basic.BlockState.CooldownQueue as Transient
 import Concordium.GlobalState.BlockState
 import Concordium.GlobalState.Parameters
 import Concordium.GlobalState.Persistent.Account.EncryptedAmount
@@ -1206,5 +1205,5 @@ toTransientAccount PersistentAccount{..} = do
         PersistentAccountStakeNone -> return AccountStakeNone
         PersistentAccountStakeBaker bkr -> AccountStakeBaker <$> (loadPersistentAccountBaker =<< refLoad bkr)
         PersistentAccountStakeDelegate dlg -> AccountStakeDelegate <$> refLoad dlg
-    let _accountStakeCooldown = Transient.emptyCooldownQueue
+    let _accountStakeCooldown = Transient.emptyCooldownQueue (accountVersion @av)
     return $ Transient.Account{..}
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
index da5a5667b..10fdfab3e 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
@@ -1607,7 +1607,7 @@ makePersistentAccount Transient.Account{..} = do
                 rsRef <- refMake $! rs
                 let !lockedBal = _accountReleaseSchedule ^. TARS.totalLockedUpBalance
                 return (Some (rsRef, lockedBal))
-    paedStakeCooldown <- makePersistentCooldownQueue _accountStakeCooldown
+    paedStakeCooldown <- makePersistentCooldownQueue @_ @av _accountStakeCooldown
     accountEnduringData <-
         refMake
             =<< case accountVersion @av of
diff --git a/concordium-consensus/tests/globalstate/GlobalStateTests/AccountsMigrationP6ToP7.hs b/concordium-consensus/tests/globalstate/GlobalStateTests/AccountsMigrationP6ToP7.hs
index 8d743e868..81674183a 100644
--- a/concordium-consensus/tests/globalstate/GlobalStateTests/AccountsMigrationP6ToP7.hs
+++ b/concordium-consensus/tests/globalstate/GlobalStateTests/AccountsMigrationP6ToP7.hs
@@ -34,7 +34,6 @@ import Concordium.GlobalState.Account
 import qualified Concordium.GlobalState.AccountMap.LMDB as LMDBAccountMap
 import qualified Concordium.GlobalState.Basic.BlockState.Account as Transient
 import qualified Concordium.GlobalState.Basic.BlockState.AccountReleaseSchedule as Transient
-import qualified Concordium.GlobalState.Basic.BlockState.CooldownQueue as Transient
 import Concordium.GlobalState.CooldownQueue
 import Concordium.GlobalState.DummyData
 import Concordium.GlobalState.Persistent.Account
@@ -78,7 +77,12 @@ dummyPersisingAccountData seed =
 
 -- | Create a test account with the given persisting data and stake.
 --  The balance of the account is set to 1 billion CCD (10^15 uCCD).
-testAccount :: (IsAccountVersion av) => PersistingAccountData -> AccountStake av -> Transient.Account av
+testAccount ::
+    forall av.
+    (IsAccountVersion av) =>
+    PersistingAccountData ->
+    AccountStake av ->
+    Transient.Account av
 testAccount persisting stake =
     Transient.Account
         { _accountPersisting = Transient.makeAccountPersisting persisting,
@@ -87,7 +91,7 @@ testAccount persisting stake =
           _accountEncryptedAmount = initialAccountEncryptedAmount,
           _accountReleaseSchedule = Transient.emptyAccountReleaseSchedule,
           _accountStaking = stake,
-          _accountStakeCooldown = Transient.emptyCooldownQueue
+          _accountStakeCooldown = Transient.emptyCooldownQueue (accountVersion @av)
         }
 
 -- | Initial stake for a test account, set to 500 million CCD plus @2^accountIndex@ uCCD.

From a07db0fcfc4787ba5462ef57f79df9c317d2c7f9 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Fri, 26 Jul 2024 16:26:14 +0200
Subject: [PATCH 41/81] Commit missing test file.

---
 .../KonsensusV1/EpochTransition.hs            | 688 ++++++++++++++++++
 1 file changed, 688 insertions(+)
 create mode 100644 concordium-consensus/tests/scheduler/SchedulerTests/KonsensusV1/EpochTransition.hs

diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/KonsensusV1/EpochTransition.hs b/concordium-consensus/tests/scheduler/SchedulerTests/KonsensusV1/EpochTransition.hs
new file mode 100644
index 000000000..04770ca1a
--- /dev/null
+++ b/concordium-consensus/tests/scheduler/SchedulerTests/KonsensusV1/EpochTransition.hs
@@ -0,0 +1,688 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+module SchedulerTests.KonsensusV1.EpochTransition where
+
+import Control.Exception
+import Control.Monad.IO.Class
+import qualified Data.Map.Strict as Map
+import Data.Maybe
+import qualified Data.Set as Set
+import Lens.Micro
+import System.FilePath
+import System.IO.Temp
+import Test.HUnit
+import Test.Hspec
+import Test.QuickCheck
+
+import qualified Concordium.Crypto.SHA256 as Hash
+import Concordium.Logger
+import Concordium.Types
+import Concordium.Types.Option
+import Concordium.Types.SeedState
+
+import Concordium.GlobalState.Account
+import qualified Concordium.GlobalState.AccountMap.LMDB as LMDBAccountMap
+import Concordium.GlobalState.BakerInfo
+import Concordium.GlobalState.BlockState
+import Concordium.GlobalState.CooldownQueue
+import qualified Concordium.GlobalState.DummyData as DummyData
+import Concordium.GlobalState.Persistent.Account
+import qualified Concordium.GlobalState.Persistent.Account.CooldownQueue as CooldownQueue
+import qualified Concordium.GlobalState.Persistent.Account.StructureV1 as SV1
+import Concordium.GlobalState.Persistent.Accounts
+import Concordium.GlobalState.Persistent.BlobStore
+import Concordium.GlobalState.Persistent.BlockState
+import qualified Concordium.GlobalState.Persistent.BlockState.Modules as Modules
+import qualified Concordium.GlobalState.Persistent.Cooldown as Cooldown
+import qualified Concordium.GlobalState.Persistent.ReleaseSchedule as ReleaseSchedule
+import qualified Concordium.GlobalState.Persistent.Trie as Trie
+import Concordium.GlobalState.Types
+import Concordium.KonsensusV1.Scheduler
+import Concordium.Kontrol.Bakers
+import Concordium.Scheduler.DummyData
+import Concordium.Types.Accounts
+import Concordium.Types.Execution
+import Concordium.Types.Parameters
+import Control.Monad
+import qualified Data.Vector as Vec
+
+dummyCooldownAccount ::
+    forall av m.
+    (IsAccountVersion av, MonadBlobStore m, AVSupportsFlexibleCooldown av) =>
+    AccountIndex ->
+    Amount ->
+    Cooldowns ->
+    m (PersistentAccount av)
+dummyCooldownAccount ai amt cooldowns = do
+    makeTestAccountFromSeed @av amt (fromIntegral ai) >>= \case
+        PAV3 acc -> do
+            let ed = SV1.enduringData acc
+            cq <- CooldownQueue.makeCooldownQueue cooldowns
+            newEnduring <- refMake =<< SV1.rehashAccountEnduringData ed{SV1.paedStakeCooldown = cq}
+            return $ PAV3 acc{SV1.accountEnduringData = newEnduring}
+
+runTestBlockState ::
+    forall pv a.
+    PersistentBlockStateMonad
+        pv
+        (PersistentBlockStateContext pv)
+        (BlobStoreT (PersistentBlockStateContext pv) (LoggerT IO))
+        a ->
+    IO a
+runTestBlockState kont = withTempDirectory "." "blockstate" $ \dir -> do
+    bracket
+        ( do
+            pbscBlobStore <- createBlobStore (dir </> "blockstate.dat")
+            pbscAccountCache <- newAccountCache 100
+            pbscModuleCache <- Modules.newModuleCache 100
+            pbscAccountMap <- LMDBAccountMap.openDatabase (dir </> "accountmap")
+            return PersistentBlockStateContext{..}
+        )
+        ( \PersistentBlockStateContext{..} -> do
+            closeBlobStore pbscBlobStore
+            LMDBAccountMap.closeDatabase pbscAccountMap
+        )
+        (runSilentLogger . runBlobStoreT (runPersistentBlockStateMonad kont))
+
+-- | Get the 'Cooldowns' for each account, and check that the indexes for cooldowns, pre-cooldowns
+--  and pre-pre-cooldowns are correct.
+checkCooldowns :: (PVSupportsFlexibleCooldown pv, SupportsPersistentState pv m) => PersistentBlockState pv -> m [Cooldowns]
+checkCooldowns pbs = do
+    bsp <- loadPBS pbs
+    (_, theCooldowns, cooldownMap, preCooldowns, prePreCooldowns) <-
+        foldAccounts
+            ( \(!ai, accum, cooldownMap, preCooldowns, prePreCooldowns) pa -> do
+                cd <- fromMaybe emptyCooldowns <$> accountCooldowns pa
+                let newCooldowns = cd : accum
+                let newCooldownMap = case Map.lookupMin (inCooldown cd) of
+                        Nothing -> cooldownMap
+                        Just (ts, _) ->
+                            Map.alter
+                                ( \case
+                                    Nothing -> Just (Set.singleton ai)
+                                    Just s -> Just (Set.insert ai s)
+                                )
+                                ts
+                                cooldownMap
+                let newPreCooldowns = case preCooldown cd of
+                        Absent -> preCooldowns
+                        Present _ -> Set.insert ai preCooldowns
+                let newPrePreCooldowns = case prePreCooldown cd of
+                        Absent -> prePreCooldowns
+                        Present _ -> Set.insert ai prePreCooldowns
+                return (ai + 1, newCooldowns, newCooldownMap, newPreCooldowns, newPrePreCooldowns)
+            )
+            (AccountIndex 0, [], Map.empty, Set.empty, Set.empty)
+            (bspAccounts bsp)
+    let aic = bspAccountsInCooldown bsp ^. Cooldown.accountsInCooldown
+    actualCooldownMap <- Trie.toMap (ReleaseSchedule.nrsMap $ aic ^. Cooldown.cooldown)
+    liftIO $ assertEqual "Cooldown map" cooldownMap (ReleaseSchedule.theAccountSet <$> actualCooldownMap)
+    actualPreCooldowns <- Set.fromList <$> Cooldown.loadAccountList (aic ^. Cooldown.preCooldown)
+    liftIO $ assertEqual "Pre-cooldown set" preCooldowns actualPreCooldowns
+    actualPrePreCooldowns <- Set.fromList <$> Cooldown.loadAccountList (aic ^. Cooldown.prePreCooldown)
+    liftIO $ assertEqual "Pre-pre-cooldown set" prePreCooldowns actualPrePreCooldowns
+    return (reverse theCooldowns)
+
+data AccountConfig (av :: AccountVersion) = AccountConfig
+    { acAccountIndex :: AccountIndex,
+      acAmount :: Amount,
+      acInitialStaking :: StakeDetails av,
+      acUpdatedStaking :: StakeDetails av,
+      acCooldowns :: Cooldowns
+    }
+    deriving (Show)
+
+-- | Generate a list of 'AccountConfig's such that:
+--
+--    * The initial staking includes at least one baker, and there are no delegators to invalid bakers.
+--    * The updated staking includes at least one baker, and there are no delegators to invalid bakers.
+--    * The amounts on the account are consistent with the active and inactive stake.
+--    * The cooldowns only include pre-cooldowns if the 'allowPreCooldown' flag is set.
+genAccountConfigs :: (AVSupportsDelegation av) => Bool -> Gen [AccountConfig av]
+genAccountConfigs allowPreCooldown = sized $ \n -> do
+    let accs = [AccountIndex 0 .. fromIntegral (max 0 n)]
+    let chooseBakers = do
+            bkrs <- sublistOf accs
+            if null bkrs
+                then (: []) <$> elements accs
+                else return bkrs
+    initBakers <- chooseBakers
+    updBakers <- chooseBakers
+    let genBakerStakeDetails sdStakedCapital = do
+            sdRestakeEarnings <- arbitrary
+            let sdPendingChange = NoChange
+            return StakeDetailsBaker{..}
+        genDelegatorStakeDetails sdStakedCapital bakers = do
+            sdRestakeEarnings <- arbitrary
+            sdDelegationTarget <-
+                oneof
+                    [ pure DelegatePassive,
+                      DelegateToBaker . BakerId <$> elements bakers
+                    ]
+            let sdPendingChange = NoChange
+            return StakeDetailsDelegator{..}
+        genCooldowns = do
+            inCooldown <- Map.fromList <$> listOf (((,) . Timestamp <$> arbitrary) <*> arbitrary)
+            preCooldown <-
+                if allowPreCooldown
+                    then oneof [return Absent, Present <$> arbitrary]
+                    else return Absent
+            prePreCooldown <- oneof [return Absent, Present <$> arbitrary]
+            return Cooldowns{..}
+        genAcc acAccountIndex = do
+            initStakeAmount <- Amount <$> choose (1_000_000, 1_000_000_000)
+            acInitialStaking <-
+                if acAccountIndex `elem` initBakers
+                    then genBakerStakeDetails initStakeAmount
+                    else
+                        oneof
+                            [ genDelegatorStakeDetails initStakeAmount initBakers,
+                              pure StakeDetailsNone
+                            ]
+            updatedStakeAmount <- Amount <$> choose (1_000_000, 1_000_000_000)
+            acUpdatedStaking <-
+                if acAccountIndex `elem` updBakers
+                    then genBakerStakeDetails updatedStakeAmount
+                    else
+                        oneof
+                            [ genDelegatorStakeDetails updatedStakeAmount updBakers,
+                              pure StakeDetailsNone
+                            ]
+            acCooldowns <- genCooldowns
+            bonusAmount <- Amount <$> choose (0, 1_000_000_000)
+            let acAmount = cooldownTotal acCooldowns + updatedStakeAmount + bonusAmount
+            return AccountConfig{..}
+    mapM genAcc accs
+
+makePersistentAccountStakeEnduring ::
+    (MonadBlobStore m, AVSupportsFlexibleCooldown av, AVSupportsDelegation av, IsAccountVersion av) =>
+    StakeDetails av ->
+    AccountIndex ->
+    m (SV1.PersistentAccountStakeEnduring av, Amount)
+makePersistentAccountStakeEnduring StakeDetailsNone _ = return (SV1.PersistentAccountStakeEnduringNone, 0)
+makePersistentAccountStakeEnduring StakeDetailsBaker{..} ai = do
+    let (fulBaker, _, _, _) = DummyData.mkFullBaker (fromIntegral ai) (BakerId ai)
+    paseBakerInfo <-
+        refMake
+            BakerInfoExV1
+                { _bieBakerInfo = fulBaker ^. bakerInfo,
+                  _bieBakerPoolInfo = poolInfo
+                }
+    return
+        ( SV1.PersistentAccountStakeEnduringBaker
+            { paseBakerRestakeEarnings = sdRestakeEarnings,
+              paseBakerPendingChange = NoChange,
+              ..
+            },
+          sdStakedCapital
+        )
+  where
+    poolInfo =
+        BakerPoolInfo
+            { _poolOpenStatus = OpenForAll,
+              _poolMetadataUrl = UrlText "Some URL",
+              _poolCommissionRates =
+                CommissionRates
+                    { _finalizationCommission = makeAmountFraction 50_000,
+                      _bakingCommission = makeAmountFraction 50_000,
+                      _transactionCommission = makeAmountFraction 50_000
+                    }
+            }
+makePersistentAccountStakeEnduring StakeDetailsDelegator{..} ai = do
+    return
+        ( SV1.PersistentAccountStakeEnduringDelegator
+            { paseDelegatorId = DelegatorId ai,
+              paseDelegatorRestakeEarnings = sdRestakeEarnings,
+              paseDelegatorTarget = sdDelegationTarget,
+              paseDelegatorPendingChange = NoChange
+            },
+          sdStakedCapital
+        )
+
+-- | Create a dummy 'PersistentAccount' from an 'AccountConfig'.
+makeDummyAccount ::
+    forall av m.
+    ( IsAccountVersion av,
+      MonadBlobStore m,
+      AVSupportsFlexibleCooldown av,
+      AVSupportsDelegation av
+    ) =>
+    AccountConfig av ->
+    m (PersistentAccount av)
+makeDummyAccount AccountConfig{..} = do
+    makeTestAccountFromSeed @av acAmount (fromIntegral acAccountIndex) >>= \case
+        PAV3 acc -> do
+            let ed = SV1.enduringData acc
+            cq <- CooldownQueue.makeCooldownQueue acCooldowns
+            (staking, stakeAmount) <- makePersistentAccountStakeEnduring acInitialStaking acAccountIndex
+            newEnduring <-
+                refMake
+                    =<< SV1.rehashAccountEnduringData
+                        ed{SV1.paedStakeCooldown = cq, SV1.paedStake = staking}
+            return $
+                PAV3
+                    acc{SV1.accountEnduringData = newEnduring, SV1.accountStakedAmount = stakeAmount}
+
+-- | Construct an initial state for testing based on the account configuration provided.
+makeInitialState ::
+    forall pv m.
+    ( SupportsPersistentState pv m,
+      PVSupportsFlexibleCooldown pv,
+      IsConsensusV1 pv,
+      BlockStateOperations m,
+      UpdatableBlockState m ~ PersistentBlockState pv,
+      IsSupported 'PTTimeParameters (ChainParametersVersionFor pv) ~ 'True
+    ) =>
+    -- | Initial configuration of accounts.
+    [AccountConfig (AccountVersionFor pv)] ->
+    -- | Initial seed state.
+    SeedState (SeedStateVersionFor pv) ->
+    -- | Length of the reward period.
+    RewardPeriodLength ->
+    m (PersistentBlockState pv)
+makeInitialState accs seedState rpLen = withIsAuthorizationsVersionForPV (protocolVersion @pv) $ do
+    initialAccounts <- mapM makeDummyAccount accs
+    let chainParams :: ChainParameters pv
+        chainParams = DummyData.dummyChainParameters & cpTimeParameters . tpRewardPeriodLength .~ rpLen
+    initialBS <-
+        initialPersistentState
+            seedState
+            DummyData.dummyCryptographicParameters
+            initialAccounts
+            DummyData.dummyIdentityProviders
+            DummyData.dummyArs
+            DummyData.dummyKeyCollection
+            chainParams
+    let pbs0 = hpbsPointers initialBS
+    (activeBakers, passiveDelegators) <- bsoGetActiveBakersAndDelegators pbs0
+    let BakerStakesAndCapital{..} = computeBakerStakesAndCapital (chainParams ^. cpPoolParameters) activeBakers passiveDelegators
+    pbs1 <- bsoSetNextEpochBakers pbs0 bakerStakes (chainParams ^. cpFinalizationCommitteeParameters)
+    capDist <- capitalDistributionM
+    pbs2 <- bsoSetNextCapitalDistribution pbs1 capDist
+    pbs <- bsoRotateCurrentCapitalDistribution =<< bsoRotateCurrentEpochBakers pbs2
+
+    bsp <- loadPBS pbs
+    -- Now we update the accounts with the updated staking information.
+    let
+        updateAccountStake ::
+            AccountConfig (AccountVersionFor pv) ->
+            PersistentAccount (AccountVersionFor pv) ->
+            m (PersistentAccount (AccountVersionFor pv))
+        updateAccountStake AccountConfig{..} (PAV3 pa) = do
+            (staking, newStakeAmount) <- makePersistentAccountStakeEnduring acUpdatedStaking acAccountIndex
+            let ed = SV1.enduringData pa
+            newEnduring <- refMake =<< SV1.rehashAccountEnduringData ed{SV1.paedStake = staking}
+            return $ PAV3 pa{SV1.accountEnduringData = newEnduring, SV1.accountStakedAmount = newStakeAmount}
+    newAccounts <-
+        foldM
+            (\a ac -> updateAccountsAtIndex' (updateAccountStake ac) (acAccountIndex ac) a)
+            (bspAccounts bsp)
+            accs
+    accts <- foldAccountsDesc (\l acc -> return (acc : l)) [] newAccounts
+    newBirkParameters <- initialBirkParameters accts seedState (chainParams ^. cpFinalizationCommitteeParameters)
+    storePBS pbs bsp{bspAccounts = newAccounts, bspBirkParameters = newBirkParameters}
+
+transitionalSeedState :: Epoch -> Timestamp -> SeedState SeedStateVersion1
+transitionalSeedState curEpoch triggerTime =
+    (initialSeedStateV1 (Hash.hash "NONCE") triggerTime)
+        { ss1Epoch = curEpoch,
+          ss1EpochTransitionTriggered = True
+        }
+
+-- | Test an epoch transition with no payday or snapshot.
+testEpochTransitionNoPaydayNoSnapshot :: [AccountConfig 'AccountV3] -> Assertion
+testEpochTransitionNoPaydayNoSnapshot accountConfigs = runTestBlockState @P7 $ do
+    bs0 <- makeInitialState accountConfigs (transitionalSeedState startEpoch startTriggerTime) 2
+    initCapDist <- bsoGetCurrentCapitalDistribution bs0
+    initBakers <- bsoGetCurrentEpochFullBakersEx bs0
+    bs1 <- bsoSetPaydayEpoch bs0 (startEpoch + 10)
+    (mPaydayParams, resState) <- doEpochTransition True hour bs1
+    liftIO $ assertEqual "Payday parameters" Nothing mPaydayParams
+    newCooldowns <- checkCooldowns resState
+    liftIO $ assertEqual "Cooldowns should be unchanged" (map acCooldowns accountConfigs) newCooldowns
+    ss <- bsoGetSeedState resState
+    case ss of
+        SeedStateV1{..} -> liftIO $ do
+            assertEqual "Epoch should be updated" (startEpoch + 1) ss1Epoch
+            assertEqual
+                "Trigger time should be updated"
+                (addDuration startTriggerTime hour)
+                ss1TriggerBlockTime
+            assertEqual
+                "Epoch transition should no longer be triggered"
+                False
+                ss1EpochTransitionTriggered
+    finalCapDist <- bsoGetCurrentCapitalDistribution resState
+    liftIO $ assertEqual "Capital distribution should be unchanged" initCapDist finalCapDist
+    finalBakers <- bsoGetCurrentEpochFullBakersEx resState
+    liftIO $ assertEqual "Bakers should be unchanged" initBakers finalBakers
+    updBakers <- bsoRotateCurrentCapitalDistribution =<< bsoRotateCurrentEpochBakers resState
+    finalNECapDist <- bsoGetCurrentCapitalDistribution updBakers
+    liftIO $ assertEqual "Next-epoch capital distribution should be unchanged" initCapDist finalNECapDist
+    finalNEBakers <- bsoGetCurrentEpochFullBakersEx updBakers
+    liftIO $ assertEqual "Next-epoch bakers should be unchanged" initBakers finalNEBakers
+  where
+    hour = Duration 3_600_000
+    startEpoch = 10
+    startTriggerTime = 1000
+
+-- | Test a payday epoch transition.
+testEpochTransitionPaydayOnly :: [AccountConfig 'AccountV3] -> Assertion
+testEpochTransitionPaydayOnly accountConfigs = runTestBlockState @P7 $ do
+    bs0 <- makeInitialState accountConfigs (transitionalSeedState startEpoch startTriggerTime) 2
+    initCapDist <- bsoGetCurrentCapitalDistribution bs0
+    initBakers <- bsoGetCurrentEpochFullBakersEx bs0
+    bs1 <- bsoSetPaydayEpoch bs0 (startEpoch + 1)
+    (mPaydayParams, resState) <- doEpochTransition True hour bs1
+    liftIO $ case mPaydayParams of
+        Just PaydayParameters{..} -> do
+            assertEqual "Payday capital distribution" initCapDist paydayCapitalDistribution
+            assertEqual "Payday bakers" initBakers paydayBakers
+        Nothing -> do
+            assertFailure "Expected payday parameters"
+    newCooldowns <- checkCooldowns resState
+    let processCooldownAtPayday =
+            processPreCooldown (startTriggerTime `addDurationSeconds` cooldownDuration)
+                . processCooldowns startTriggerTime
+    liftIO $
+        assertEqual
+            "Expired cooldowns should be processed and pre-cooldowns should be moved to cooldowns"
+            (map (processCooldownAtPayday . acCooldowns) accountConfigs)
+            newCooldowns
+    ss <- bsoGetSeedState resState
+    case ss of
+        SeedStateV1{..} -> liftIO $ do
+            assertEqual "Epoch should be updated" (startEpoch + 1) ss1Epoch
+            assertEqual
+                "Trigger time should be updated"
+                (addDuration startTriggerTime hour)
+                ss1TriggerBlockTime
+            assertEqual
+                "Epoch transition should no longer be triggered"
+                False
+                ss1EpochTransitionTriggered
+    finalCapDist <- bsoGetCurrentCapitalDistribution resState
+    liftIO $ assertEqual "Capital distribution should be unchanged" initCapDist finalCapDist
+    finalBakers <- bsoGetCurrentEpochFullBakersEx resState
+    liftIO $ assertEqual "Bakers should be unchanged" initBakers finalBakers
+    updBakers <- bsoRotateCurrentCapitalDistribution =<< bsoRotateCurrentEpochBakers resState
+    finalNECapDist <- bsoGetCurrentCapitalDistribution updBakers
+    liftIO $ assertEqual "Next-epoch capital distribution should be unchanged" initCapDist finalNECapDist
+    finalNEBakers <- bsoGetCurrentEpochFullBakersEx updBakers
+    liftIO $ assertEqual "Next-epoch bakers should be unchanged" initBakers finalNEBakers
+  where
+    hour = Duration 3_600_000
+    startEpoch = 10
+    startTriggerTime = 1000
+    cooldownDuration =
+        DummyData.dummyChainParameters @ChainParametersV2
+            ^. cpCooldownParameters . cpUnifiedCooldown
+
+-- | Test an snapshot epoch transition.
+testEpochTransitionSnapshotOnly :: [AccountConfig 'AccountV3] -> Assertion
+testEpochTransitionSnapshotOnly accountConfigs = runTestBlockState @P7 $ do
+    bs0 <- makeInitialState accountConfigs (transitionalSeedState startEpoch startTriggerTime) 2
+    initCapDist <- bsoGetCurrentCapitalDistribution bs0
+    initBakers <- bsoGetCurrentEpochFullBakersEx bs0
+    bs1 <- bsoSetPaydayEpoch bs0 (startEpoch + 2)
+    (activeBakers, activeDelegators) <- bsoGetActiveBakersAndDelegators bs1
+    let BakerStakesAndCapital{..} =
+            computeBakerStakesAndCapital
+                (chainParams ^. cpPoolParameters)
+                activeBakers
+                activeDelegators
+    updatedCapitalDistr <- capitalDistributionM
+    let mkFullBaker (ref, stake) = do
+            loadPersistentBakerInfoRef @_ @'AccountV3 ref <&> \case
+                (BakerInfoExV1 info extra) ->
+                    FullBakerInfoEx
+                        { _exFullBakerInfo = FullBakerInfo info stake,
+                          _bakerPoolCommissionRates = extra ^. poolCommissionRates
+                        }
+    bkrs <- mapM mkFullBaker bakerStakes
+    let updatedBakerStakes = FullBakersEx (Vec.fromList bkrs) (sum $ snd <$> bakerStakes)
+
+    (mPaydayParams, resState) <- doEpochTransition True hour bs1
+    liftIO $ assertEqual "Payday parameters" Nothing mPaydayParams
+    newCooldowns <- checkCooldowns resState
+    liftIO $
+        assertEqual
+            "Expired cooldowns should be processed and pre-cooldowns should be moved to cooldowns"
+            (map (processPrePreCooldown . acCooldowns) accountConfigs)
+            newCooldowns
+    ss <- bsoGetSeedState resState
+    case ss of
+        SeedStateV1{..} -> liftIO $ do
+            assertEqual "Epoch should be updated" (startEpoch + 1) ss1Epoch
+            assertEqual
+                "Trigger time should be updated"
+                (addDuration startTriggerTime hour)
+                ss1TriggerBlockTime
+            assertEqual
+                "Epoch transition should no longer be triggered"
+                False
+                ss1EpochTransitionTriggered
+    finalCapDist <- bsoGetCurrentCapitalDistribution resState
+    liftIO $ assertEqual "Capital distribution should be unchanged" initCapDist finalCapDist
+    finalBakers <- bsoGetCurrentEpochFullBakersEx resState
+    liftIO $ assertEqual "Bakers should be unchanged" initBakers finalBakers
+    updBakers <- bsoRotateCurrentCapitalDistribution =<< bsoRotateCurrentEpochBakers resState
+    finalNECapDist <- bsoGetCurrentCapitalDistribution updBakers
+    liftIO $ assertEqual "Next-epoch capital distribution should be updated" updatedCapitalDistr finalNECapDist
+    finalNEBakers <- bsoGetCurrentEpochFullBakersEx updBakers
+    liftIO $ assertEqual "Next-epoch bakers should be updated" updatedBakerStakes finalNEBakers
+  where
+    hour = Duration 3_600_000
+    startEpoch = 10
+    startTriggerTime = 1000
+    chainParams = DummyData.dummyChainParameters @ChainParametersV2
+
+-- | Test two successive epoch transitions where the first is a snapshot and the second is a payday.
+testEpochTransitionSnapshotPayday :: [AccountConfig 'AccountV3] -> Assertion
+testEpochTransitionSnapshotPayday accountConfigs = runTestBlockState @P7 $ do
+    bs0 <- makeInitialState accountConfigs (transitionalSeedState startEpoch startTriggerTime) 2
+    initCapDist <- bsoGetCurrentCapitalDistribution bs0
+    initBakers <- bsoGetCurrentEpochFullBakersEx bs0
+    bs1 <- bsoSetPaydayEpoch bs0 (startEpoch + 2)
+    (activeBakers, activeDelegators) <- bsoGetActiveBakersAndDelegators bs1
+    let BakerStakesAndCapital{..} =
+            computeBakerStakesAndCapital
+                (chainParams ^. cpPoolParameters)
+                activeBakers
+                activeDelegators
+    updatedCapitalDistr <- capitalDistributionM
+    let mkFullBaker (ref, stake) = do
+            loadPersistentBakerInfoRef @_ @'AccountV3 ref <&> \case
+                (BakerInfoExV1 info extra) ->
+                    FullBakerInfoEx
+                        { _exFullBakerInfo = FullBakerInfo info stake,
+                          _bakerPoolCommissionRates = extra ^. poolCommissionRates
+                        }
+    bkrs <- mapM mkFullBaker bakerStakes
+    let updatedBakerStakes = FullBakersEx (Vec.fromList bkrs) (sum $ snd <$> bakerStakes)
+
+    (mPaydayParams, snapshotState) <- doEpochTransition True hour bs1
+    liftIO $ assertEqual "Payday parameters" Nothing mPaydayParams
+    newCooldowns <- checkCooldowns snapshotState
+    let expectCooldowns1 = processPrePreCooldown . acCooldowns <$> accountConfigs
+    liftIO $
+        assertEqual
+            "Pre-pre-cooldowns should be moved to pre-cooldown"
+            expectCooldowns1
+            newCooldowns
+    ss <- bsoGetSeedState snapshotState
+    case ss of
+        SeedStateV1{..} -> liftIO $ do
+            assertEqual "Epoch should be updated" (startEpoch + 1) ss1Epoch
+            assertEqual
+                "Trigger time should be updated"
+                (addDuration startTriggerTime hour)
+                ss1TriggerBlockTime
+            assertEqual
+                "Epoch transition should no longer be triggered"
+                False
+                ss1EpochTransitionTriggered
+    snapshotCapDist <- bsoGetCurrentCapitalDistribution snapshotState
+    liftIO $ assertEqual "Capital distribution should be unchanged" initCapDist snapshotCapDist
+    snapshotBakers <- bsoGetCurrentEpochFullBakersEx snapshotState
+    liftIO $ assertEqual "Bakers should be unchanged" initBakers snapshotBakers
+
+    (mPaydayParams', resState) <- doEpochTransition True hour snapshotState
+    liftIO $ case mPaydayParams' of
+        Just PaydayParameters{..} -> do
+            assertEqual "Payday capital distribution" initCapDist paydayCapitalDistribution
+            assertEqual "Payday bakers" initBakers paydayBakers
+        Nothing -> do
+            assertFailure "Expected payday parameters"
+    newCooldowns' <- checkCooldowns resState
+    let paydayTime = startTriggerTime `addDuration` hour
+    let processCooldownAtPayday =
+            processPreCooldown (paydayTime `addDurationSeconds` cooldownDuration)
+                . processCooldowns paydayTime
+    let expectCooldowns2 = processCooldownAtPayday <$> expectCooldowns1
+    liftIO $
+        assertEqual
+            "Expired cooldowns should be processed and pre-cooldowns should be moved to cooldowns"
+            expectCooldowns2
+            newCooldowns'
+    finalCapDist <- bsoGetCurrentCapitalDistribution resState
+    liftIO $ assertEqual "Capital distribution should be updated" updatedCapitalDistr finalCapDist
+    finalBakers <- bsoGetCurrentEpochFullBakersEx resState
+    liftIO $ assertEqual "Bakers should be updated" updatedBakerStakes finalBakers
+
+    updBakers <- bsoRotateCurrentCapitalDistribution =<< bsoRotateCurrentEpochBakers resState
+    finalNECapDist <- bsoGetCurrentCapitalDistribution updBakers
+    liftIO $ assertEqual "Next-epoch capital distribution should be updated" updatedCapitalDistr finalNECapDist
+    finalNEBakers <- bsoGetCurrentEpochFullBakersEx updBakers
+    liftIO $ assertEqual "Next-epoch bakers should be updated" updatedBakerStakes finalNEBakers
+  where
+    hour = Duration 3_600_000
+    startEpoch = 10
+    startTriggerTime = 1000
+    chainParams = DummyData.dummyChainParameters @ChainParametersV2
+    cooldownDuration = chainParams ^. cpCooldownParameters . cpUnifiedCooldown
+
+-- | Test epoch transitions for two successive transitions where the payday length is one epoch.
+-- In this case, both the snapshot and payday processing occur on each transition, so this tests
+-- that they are correctly ordered.
+testEpochTransitionSnapshotPaydayCombo :: [AccountConfig 'AccountV3] -> Assertion
+testEpochTransitionSnapshotPaydayCombo accountConfigs = runTestBlockState @P7 $ do
+    -- Setup the initial state.
+    bs0 <- makeInitialState accountConfigs (transitionalSeedState startEpoch startTriggerTime) 1
+    initCapDist <- bsoGetCurrentCapitalDistribution bs0
+    initBakers <- bsoGetCurrentEpochFullBakersEx bs0
+    bs1 <- bsoSetPaydayEpoch bs0 (startEpoch + 1)
+    (activeBakers, activeDelegators) <- bsoGetActiveBakersAndDelegators bs1
+    let BakerStakesAndCapital{..} =
+            computeBakerStakesAndCapital
+                (chainParams ^. cpPoolParameters)
+                activeBakers
+                activeDelegators
+    updatedCapitalDistr <- capitalDistributionM
+    let mkFullBaker (ref, stake) = do
+            loadPersistentBakerInfoRef @_ @'AccountV3 ref <&> \case
+                (BakerInfoExV1 info extra) ->
+                    FullBakerInfoEx
+                        { _exFullBakerInfo = FullBakerInfo info stake,
+                          _bakerPoolCommissionRates = extra ^. poolCommissionRates
+                        }
+    bkrs <- mapM mkFullBaker bakerStakes
+    let updatedBakerStakes = FullBakersEx (Vec.fromList bkrs) (sum $ snd <$> bakerStakes)
+
+    -- First epoch transition.
+    (mPaydayParams, snapshotState) <- doEpochTransition True hour bs1
+    liftIO $ case mPaydayParams of
+        Just PaydayParameters{..} -> do
+            assertEqual "Payday capital distribution (1)" initCapDist paydayCapitalDistribution
+            assertEqual "Payday bakers (1)" initBakers paydayBakers
+        Nothing -> do
+            assertFailure "Expected payday parameters (1)"
+    newCooldowns1 <- checkCooldowns snapshotState
+    let processPaydayCooldowns paydayTime =
+            processPrePreCooldown
+                . processPreCooldown (paydayTime `addDurationSeconds` cooldownDuration)
+                . processCooldowns paydayTime
+    let expectedCooldowns1 = processPaydayCooldowns startTriggerTime . acCooldowns <$> accountConfigs
+    liftIO $
+        assertEqual
+            "Cooldowns should be processed at payday (1)"
+            expectedCooldowns1
+            newCooldowns1
+    ss <- bsoGetSeedState snapshotState
+    case ss of
+        SeedStateV1{..} -> liftIO $ do
+            assertEqual "Epoch should be updated (1)" (startEpoch + 1) ss1Epoch
+            assertEqual
+                "Trigger time should be updated (1)"
+                (addDuration startTriggerTime hour)
+                ss1TriggerBlockTime
+            assertEqual
+                "Epoch transition should no longer be triggered (1)"
+                False
+                ss1EpochTransitionTriggered
+    snapshotCapDist <- bsoGetCurrentCapitalDistribution snapshotState
+    liftIO $ assertEqual "Capital distribution should be unchanged (1)" initCapDist snapshotCapDist
+    snapshotBakers <- bsoGetCurrentEpochFullBakersEx snapshotState
+    liftIO $ assertEqual "Bakers should be unchanged (1)" initBakers snapshotBakers
+
+    -- Second epoch transition.
+    let payday2Time = startTriggerTime `addDuration` hour
+    (mPaydayParams', resState) <- doEpochTransition True hour snapshotState
+    liftIO $ case mPaydayParams' of
+        Just PaydayParameters{..} -> do
+            assertEqual "Payday capital distribution" initCapDist paydayCapitalDistribution
+            assertEqual "Payday bakers" initBakers paydayBakers
+        Nothing -> do
+            assertFailure "Expected payday parameters"
+    newCooldowns2 <- checkCooldowns snapshotState
+    let expectedCooldowns2 = processPaydayCooldowns payday2Time <$> expectedCooldowns1
+    liftIO $
+        assertEqual
+            "Cooldowns should be processed at payday (2)"
+            expectedCooldowns2
+            newCooldowns2
+    bsoGetSeedState snapshotState >>= \case
+        SeedStateV1{..} -> liftIO $ do
+            assertEqual "Epoch should be updated (2)" (startEpoch + 2) ss1Epoch
+            assertEqual
+                "Trigger time should be updated (2)"
+                (addDuration payday2Time hour)
+                ss1TriggerBlockTime
+            assertEqual
+                "Epoch transition should no longer be triggered (2)"
+                False
+                ss1EpochTransitionTriggered
+    finalCapDist <- bsoGetCurrentCapitalDistribution resState
+    liftIO $ assertEqual "Capital distribution should be updated (2)" updatedCapitalDistr finalCapDist
+    finalBakers <- bsoGetCurrentEpochFullBakersEx resState
+    liftIO $ assertEqual "Bakers should be updated (2)" updatedBakerStakes finalBakers
+    updBakers <- bsoRotateCurrentCapitalDistribution =<< bsoRotateCurrentEpochBakers resState
+    finalNECapDist <- bsoGetCurrentCapitalDistribution updBakers
+    liftIO $ assertEqual "Next-epoch capital distribution should be updated (2)" updatedCapitalDistr finalNECapDist
+    finalNEBakers <- bsoGetCurrentEpochFullBakersEx updBakers
+    liftIO $ assertEqual "Next-epoch bakers should be updated (2)" updatedBakerStakes finalNEBakers
+  where
+    hour = Duration 3_600_000
+    startEpoch = 10
+    startTriggerTime = 1000
+    chainParams = DummyData.dummyChainParameters @ChainParametersV2
+    cooldownDuration = chainParams ^. cpCooldownParameters . cpUnifiedCooldown
+
+tests :: Spec
+tests = parallel $ describe "EpochTransition" $ do
+    it "testEpochTransitionNoPaydayNoSnapshot" $
+        forAll (genAccountConfigs True) testEpochTransitionNoPaydayNoSnapshot
+    it "testEpochTransitionPaydayOnly" $
+        forAll (genAccountConfigs True) testEpochTransitionPaydayOnly
+    it "testEpochTransitionSnapshotOnly" $
+        forAll (genAccountConfigs False) testEpochTransitionSnapshotOnly
+    it "testEpochTransitionSnapshotPayday" $
+        forAll (genAccountConfigs False) testEpochTransitionSnapshotPayday
+    it "testEpochTransitionSnapshotPaydayCombo" $
+        forAll (genAccountConfigs False) testEpochTransitionSnapshotPaydayCombo

From 2cebf76442772ce3075283d1dc2c646a88b0be39 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Mon, 29 Jul 2024 17:41:45 +0200
Subject: [PATCH 42/81] Refine account migration.

---
 .../GlobalState/Persistent/Account.hs         | 14 ++++
 .../Persistent/Account/MigrationState.hs      | 52 ++++++++----
 .../Account/MigrationStateInterface.hs        | 17 +++-
 .../Persistent/Account/StructureV1.hs         | 83 +++++++++++++++----
 .../GlobalState/Persistent/Accounts.hs        |  4 +-
 concordium-node/Cargo.lock                    |  2 +-
 concordium-node/Cargo.toml                    |  2 +-
 7 files changed, 133 insertions(+), 41 deletions(-)

diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs
index 571eac63a..e1ca93500 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs
@@ -648,6 +648,20 @@ makePersistentBakerInfoRef = case accountVersion @av of
 -- * Migration
 
 -- | Migrate a 'PersistentAccount' between protocol versions according to a state migration.
+--
+--  When migrating P6->P7 (account version 2 to 3), the 'AccountMigration' interface is used as
+--  follows:
+--
+--   * Accounts that previously had a pending change are updated to have a pre-pre-cooldown, and
+--     'addAccountInPrePreCooldown' is called. If the pending change is a reduction in stake,
+--     the reduction is applied immediately to the active stake. If the pending change is a removal,
+--     the baker or delegator record is removed altogether.
+--
+--   * Accounts that are still delegating but were delegating to a baker for which 'isBakerRemoved'
+--     returns @True@ are updated to delegate to passive delegation.
+--
+--   * For accounts that are still delegating, 'retainDelegator' is called to record the (new)
+--     delegation amount and target.
 migratePersistentAccount ::
     forall oldpv pv t m.
     ( IsProtocolVersion oldpv,
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationState.hs
index ffcf5029e..746af9b8c 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationState.hs
@@ -34,22 +34,26 @@ import Concordium.GlobalState.Persistent.Cache
 import Concordium.GlobalState.Persistent.Cooldown
 import qualified Concordium.GlobalState.Persistent.Trie as Trie
 
+-- | Whether the migration from one protocol version to another introduces flexible cooldown
+--  support.
+type IntroducesFlexibleCooldown (oldpv :: ProtocolVersion) (pv :: ProtocolVersion) =
+    Not (SupportsFlexibleCooldown (AccountVersionFor oldpv))
+        && SupportsFlexibleCooldown (AccountVersionFor pv)
+
 data AccountMigrationState (oldpv :: ProtocolVersion) (pv :: ProtocolVersion) = AccountMigrationState
     { -- | In the P6 -> P7 protocol update, this records the accounts that previously were in
       --  cooldown, and now will be in pre-pre-cooldown.
       _migrationPrePreCooldown ::
         !( Conditionally
-            ( Not (SupportsFlexibleCooldown (AccountVersionFor oldpv))
-                && SupportsFlexibleCooldown (AccountVersionFor pv)
-            )
+            (IntroducesFlexibleCooldown oldpv pv)
             AccountList
          ),
-      -- | When migrating to P7 (and onwards), we will build up the 'PersistentActiveBakers' while
+      -- | When migrating P6->P7, we build up the 'PersistentActiveBakers' while
       --  traversing the account table. This should be initialised with the active bakers (that
       --  survive migration) but no delegators.
       _persistentActiveBakers ::
         !( Conditionally
-            (SupportsFlexibleCooldown (AccountVersionFor pv))
+            (IntroducesFlexibleCooldown oldpv pv)
             (PersistentActiveBakers (AccountVersionFor pv))
          ),
       -- | A counter to track the index of the current account as we traverse the account table.
@@ -59,12 +63,13 @@ makeLenses ''AccountMigrationState
 
 -- | Construct an initial 'PersistentActiveBakers' that records all of the bakers that are still
 -- active after migration, but does not include any delegators. This only applies when migrating
--- to a protocol version from P7 onwards. The total active capital constitutes the stake of all
--- bakers that remain active, with their capital reduced corresponding to any pending reduction
--- in their stakes.
+-- to a protocol version that supports flexible cooldowns for the first time. The total active
+-- capital constitutes the stake of all bakers that remain active, with their capital reduced
+-- corresponding to any pending reduction in their stakes.
 --
 -- The idea is that with the P6->P7 migration, bakers that are in cooldown to be removed will
--- actually be removed as bakers.
+-- actually be removed as bakers. During the processing of the account table, the delegators
+-- will be added back to the 'PersistentActiveBakers' as they are encountered.
 initialPersistentActiveBakersForMigration ::
     forall oldpv av t m.
     ( IsAccountVersion av,
@@ -73,10 +78,16 @@ initialPersistentActiveBakersForMigration ::
     ) =>
     Accounts oldpv ->
     PersistentActiveBakers (AccountVersionFor oldpv) ->
-    t m (Conditionally (SupportsFlexibleCooldown av) (PersistentActiveBakers av))
-initialPersistentActiveBakersForMigration oldAccounts oldActiveBakers = case sSupportsFlexibleCooldown (accountVersion @av) of
-    SFalse -> return CFalse
-    STrue -> do
+    t
+        m
+        ( Conditionally
+            (Not (SupportsFlexibleCooldown (AccountVersionFor oldpv)) && SupportsFlexibleCooldown av)
+            (PersistentActiveBakers av)
+        )
+initialPersistentActiveBakersForMigration oldAccounts oldActiveBakers = case (oldSFC, newSFC) of
+    (SFalse, SFalse) -> return CFalse
+    (STrue, _) -> return CFalse
+    (SFalse, STrue) -> do
         bakers <- lift $ Trie.keysAsc (oldActiveBakers ^. activeBakers)
         CTrue <$> foldM accumBakers emptyPersistentActiveBakers bakers
       where
@@ -111,6 +122,9 @@ initialPersistentActiveBakersForMigration oldAccounts oldActiveBakers = case sSu
                                           _aggregationKeys = newAggregationKeys,
                                           _totalActiveCapital = newTotalActiveCapital
                                         }
+  where
+    oldSFC = sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor oldpv))
+    newSFC = sSupportsFlexibleCooldown (accountVersion @av)
 
 -- | An 'AccountMigrationState' in an initial state.
 initialAccountMigrationState ::
@@ -118,7 +132,7 @@ initialAccountMigrationState ::
     (IsProtocolVersion oldpv, IsProtocolVersion pv) =>
     -- | The active bakers without the delegators.
     Conditionally
-        (SupportsFlexibleCooldown (AccountVersionFor pv))
+        (IntroducesFlexibleCooldown oldpv pv)
         (PersistentActiveBakers (AccountVersionFor pv)) ->
     AccountMigrationState oldpv pv
 initialAccountMigrationState _persistentActiveBakers = AccountMigrationState{..}
@@ -164,6 +178,8 @@ newtype
           LMDBAccountMap.MonadAccountMapStore
         )
 
+-- | Run an 'AccountMigrationStateTT' computation with the given initial state.
+--  This is used to add 'AccountMigration' and 'AccountsMigration' interfaces to the monad stack.
 runAccountMigrationStateTT ::
     AccountMigrationStateTT oldpv pv t m a ->
     AccountMigrationState oldpv pv ->
@@ -215,8 +231,6 @@ instance
                 migrationPrePreCooldown .= CTrue (Some newHead)
             CFalse -> return ()
 
-    nextAccount = currentAccountIndex %=! (+ 1)
-
     isBakerRemoved bakerId =
         use persistentActiveBakers >>= \case
             CFalse -> return False
@@ -240,3 +254,9 @@ instance
                         persistentActiveBakers
                             .= CTrue (newPAB & totalActiveCapital %~ addActiveCapital delAmt)
             CFalse -> return ()
+
+instance
+    (MonadBlobStore (t m), IsProtocolVersion pv, av ~ AccountVersionFor pv) =>
+    AccountsMigration av (AccountMigrationStateTT oldpv pv t m)
+    where
+    nextAccount = currentAccountIndex %=! (+ 1)
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationStateInterface.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationStateInterface.hs
index 6e0e23a20..b5fa38b62 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationStateInterface.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationStateInterface.hs
@@ -3,19 +3,28 @@ module Concordium.GlobalState.Persistent.Account.MigrationStateInterface where
 import Concordium.Types
 import Concordium.Types.Execution
 
+-- | This class provides functionality used during account migration. Much of this functionality
+--  is dependent on the protocol versions involved in the migration. This interface is used when
+--  migrating one particular account.
 class AccountMigration (av :: AccountVersion) m | m -> av where
     -- | Add the current account to the set of accounts that should be considered in
     --  pre-pre-cooldown as part of migration. This only has an effect when transitioning from a
     --  protocol version that does not support flexible cooldown to one that does.
     addAccountInPrePreCooldown :: m ()
 
-    -- | Progress to the next sequential account index.
-    nextAccount :: m ()
-
     -- | Query if the given 'BakerId' is set to be removed in this migration.
     --  (The result is unspecified if the 'BakerId' was not a baker prior to migration.)
     isBakerRemoved :: BakerId -> m Bool
 
     -- | Record that a delegator is retained, delegating a specified amount to a delegation target.
-    --  The delegator must not already have been retained.
+    --  The delegator must not already have been retained. This MUST be called for every delegator
+    --  that remains a delegator after migration when transitioning from a protocol version that
+    --  does not support flexible delegation to one that does. Outside of such a transition, this
+    --  has no effect.
     retainDelegator :: (AVSupportsDelegation av) => DelegatorId -> Amount -> DelegationTarget -> m ()
+
+-- | This class provides functionality used during account migration. This interface is used when
+--  migrating the entire account table.
+class (AccountMigration av m) => AccountsMigration (av :: AccountVersion) m | m -> av where
+    -- | Progress to the next sequential account index.
+    nextAccount :: m ()
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
index 10fdfab3e..a7dd4a4c1 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
@@ -206,19 +206,25 @@ migratePersistentAccountStakeEnduring PersistentAccountStakeEnduringBaker{..} =
 migratePersistentAccountStakeEnduring PersistentAccountStakeEnduringDelegator{..} =
     return $! PersistentAccountStakeEnduringDelegator{..}
 
--- | Migrate a 'PersistentAccountStakeEnduring' from 'AccountV2' to 'AccountV3'.
---  If a cooldown is in effect on the account, then the pending change is removed and the amount
---  of stake entering cooldown is returned.
---  If the account is a delegator, then this checks if it was delegating to a baker
---  that has been removed as a result of the migration, and if so, delegates to passive instead.
---  Either way, 'retainDelegator' is called with the delegator ID and updated delegated amount and
---  target.
---  If the account is not in cooldown, 'Nothing' is returned.
--- The 'Amount' in the 'State.StateT' represents the current active stake on the account.
+-- | Migrate a 'PersistentAccountStakeEnduring' from 'AccountV2' to 'AccountV3'.  This runs in the
+--   'StateT' monad, where the state is the amount of active stake on the account.
+--
+--   * If there is a pending change on the account, then the pending change is removed and the
+--     active stake is updated to apply the pending change. The change in the stake is moved to
+--     pre-pre-cooldown in the returned 'CooldownQueue'. 'addAccountInPrePreCooldown' is called
+--     to record that the account is in pre-pre-cooldown. If the pending change was a removal,
+--     the baker or delegator record is removed from the account.
+
+--   * If the account is (still) a delegator and the baker it was delegating to has been removed
+--     (according to 'isBakerRemoved'), then the delegator is changed to delegate to passive
+--     instead.
+--
+--   * If the account is (still) a delegator, then 'retainDelegator' is called to record the
+--     delegator's (updated) stake and target.
 migratePersistentAccountStakeEnduringV2toV3 ::
     (SupportMigration m t, AccountMigration 'AccountV3 (t m)) =>
     PersistentAccountStakeEnduring 'AccountV2 ->
-    -- | Returns the new 'PersistentAccountStakeEnduring' and the amount entering cooldown (if any).
+    -- | Returns the new 'PersistentAccountStakeEnduring' and 'CooldownQueue'.
     State.StateT Amount (t m) (PersistentAccountStakeEnduring 'AccountV3, CooldownQueue 'AccountV3)
 migratePersistentAccountStakeEnduringV2toV3 PersistentAccountStakeEnduringNone =
     return (PersistentAccountStakeEnduringNone, emptyCooldownQueue)
@@ -226,7 +232,9 @@ migratePersistentAccountStakeEnduringV2toV3 PersistentAccountStakeEnduringBaker{
     case paseBakerPendingChange of
         RemoveStake _ -> do
             -- The baker is being removed, so we don't migrate it.
-            cooldownAmount <- id <<.= 0 -- Get the old stake, updating it to 0.
+            -- Get the old stake, updating it to 0.
+            cooldownAmount <- State.get
+            State.put 0
             cooldown <- initialPrePreCooldownQueue cooldownAmount
             lift addAccountInPrePreCooldown
             return (PersistentAccountStakeEnduringNone, cooldown)
@@ -256,7 +264,9 @@ migratePersistentAccountStakeEnduringV2toV3 PersistentAccountStakeEnduringBaker{
 migratePersistentAccountStakeEnduringV2toV3 PersistentAccountStakeEnduringDelegator{..} =
     case paseDelegatorPendingChange of
         RemoveStake _ -> do
-            cooldownAmount <- id <<.= 0 -- Get the old stake, updating it to 0.
+            -- Get the old stake, updating it to 0.
+            cooldownAmount <- State.get
+            State.put 0
             cooldown <- initialPrePreCooldownQueue cooldownAmount
             lift addAccountInPrePreCooldown
             return (PersistentAccountStakeEnduringNone, cooldown)
@@ -336,7 +346,7 @@ data PersistentAccountEnduringData (av :: AccountVersion) = PersistentAccountEnd
       paedReleaseSchedule :: !(Nullable (LazyBufferedRef AccountReleaseSchedule, Amount)),
       -- | The staking details associated with the account.
       paedStake :: !(PersistentAccountStakeEnduring av),
-      -- | The cooldown.
+      -- | The inactive stake in cooldown.
       paedStakeCooldown :: !(CooldownQueue av)
     }
 
@@ -1739,9 +1749,19 @@ migrateEnduringDataV2 ed = do
               ..
             }
 
--- | Migrate enduring data from 'AccountV2' to 'AccountV3'. If there was a stake cooldown in effect,
---  that is migrated to a pre-pre-cooldown in the new state. The 'Amount' in the 'State.StateT'
+-- | Migrate enduring data from 'AccountV2' to 'AccountV3'. The 'Amount' in the 'State.StateT'
 --  represents the current active stake on the account.
+--
+--   * If the account previously had a pending change, it will now have a pre-pre-cooldown, and
+--     'addAccountInPrePreCooldown' is called (to register this globally). If the pending change
+--     was a reduction in stake, the reduction is applied immediately to the active stake. If the
+--     pending change wass a removal, the baker or delegator record is removed altogether.
+--
+--   * If the account is still delegating but was delegating to a baker for which 'isBakerRemoved'
+--     returns @True@, the delegation target is updated to passive delegation.
+--
+--   * If the account is still delegating, 'retainDelegator' is called to record the (new)
+--     delegation amount and target globally.
 migrateEnduringDataV2toV3 ::
     (SupportMigration m t, AccountMigration 'AccountV3 (t m)) =>
     -- | Current enduring data
@@ -1798,8 +1818,21 @@ migrateV2ToV2 acc = do
             }
 
 -- | Migrate from account version 2 to account version 3.
---  Stake cooldowns are migrated to being in pre-pre-cooldown.
---  Otherwise, the state is unchanged on migration.
+--
+--   * If the account previously had a pending change, it will now have a pre-pre-cooldown, and
+--     'addAccountInPrePreCooldown' is called (to register this globally). If the pending change
+--     was a reduction in stake, the reduction is applied immediately to the active stake. If the
+--     pending change wass a removal, the baker or delegator record is removed altogether.
+--
+--   * If the account is still delegating but was delegating to a baker for which 'isBakerRemoved'
+--     returns @True@, the delegation target is updated to passive delegation.
+--
+--   * If the account is still delegating, 'retainDelegator' is called to record the (new)
+--     delegation amount and target globally.
+--
+--  Note: the global record of which bakers are retained and their stakes is determined a priori
+--  (see "Concordium.GlobalState.Persistent.Account.MigrationState"). This is used to determine
+--  whether a baker is removed.
 migrateV2ToV3 ::
     ( MonadBlobStore m,
       MonadBlobStore (t m),
@@ -1840,7 +1873,21 @@ migrateV3ToV3 acc = do
               ..
             }
 
--- | Migration for 'PersistentAccount'. Only supports 'AccountV2'.
+-- | Migration for 'PersistentAccount'. Supports 'AccountV2' and 'AccountV3'.
+--
+--  When migrating P6->P7 (account version 2 to 3), the 'AccountMigration' interface is used as
+--  follows:
+--
+--   * Accounts that previously had a pending change are updated to have a pre-pre-cooldown, and
+--     'addAccountInPrePreCooldown' is called. If the pending change is a reduction in stake,
+--     the reduction is applied immediately to the active stake. If the pending change is a removal,
+--     the baker or delegator record is removed altogether.
+--
+--   * Accounts that are still delegating but were delegating to a baker for which 'isBakerRemoved'
+--     returns @True@ are updated to delegate to passive delegation.
+--
+--   * For accounts that are still delegating, 'retainDelegator' is called to record the (new)
+--     delegation amount and target.
 migratePersistentAccount ::
     forall m t oldpv pv.
     ( IsProtocolVersion oldpv,
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs
index 7ebf15631..e737faafe 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs
@@ -420,6 +420,8 @@ updateAccountsAtIndex fupd ai a0@Accounts{..} =
         Nothing -> return (Nothing, a0)
         Just (res, act') -> return (Just res, a0{accountTable = act'})
 
+-- | Set the account at the given index. There must already be an account at the given index
+--  (otherwise this has no effect).
 setAccountAtIndex :: (SupportsPersistentAccount pv m) => AccountIndex -> PersistentAccount (AccountVersionFor pv) -> Accounts pv -> m (Accounts pv)
 setAccountAtIndex ai newAcct a0@Accounts{..} =
     L.update (const (return ((), newAcct))) ai accountTable >>= \case
@@ -498,7 +500,7 @@ migrateAccounts ::
       SupportMigration m t,
       SupportsPersistentAccount oldpv m,
       SupportsPersistentAccount pv (t m),
-      AccountMigration (AccountVersionFor pv) (t m)
+      AccountsMigration (AccountVersionFor pv) (t m)
     ) =>
     StateMigrationParameters oldpv pv ->
     Accounts oldpv ->
diff --git a/concordium-node/Cargo.lock b/concordium-node/Cargo.lock
index 8cb19f6e6..5359987c0 100644
--- a/concordium-node/Cargo.lock
+++ b/concordium-node/Cargo.lock
@@ -787,7 +787,7 @@ dependencies = [
 
 [[package]]
 name = "concordium_node"
-version = "6.3.1"
+version = "7.0.0"
 dependencies = [
  "anyhow",
  "app_dirs2",
diff --git a/concordium-node/Cargo.toml b/concordium-node/Cargo.toml
index 7d67e6233..4aba0463b 100644
--- a/concordium-node/Cargo.toml
+++ b/concordium-node/Cargo.toml
@@ -1,6 +1,6 @@
 [package]
 name = "concordium_node"
-version = "6.3.1" # must be kept in sync with 'is_compatible_version' in 'src/configuration.rs'
+version = "7.0.0" # must be kept in sync with 'is_compatible_version' in 'src/configuration.rs'
 description = "Concordium Node"
 authors = ["Concordium <developers@concordium.com>"]
 exclude = [".gitignore", ".gitlab-ci.yml", "test/**/*","**/**/.gitignore","**/**/.gitlab-ci.yml"]

From 5970cf95124ab6f43112c4212d5405cb2de36293 Mon Sep 17 00:00:00 2001
From: Emil B <eb@concordium.com>
Date: Tue, 30 Jul 2024 10:04:21 +0200
Subject: [PATCH 43/81] Reject adding a delegator with stake 0.

---
 concordium-consensus/src/Concordium/Scheduler.hs | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/concordium-consensus/src/Concordium/Scheduler.hs b/concordium-consensus/src/Concordium/Scheduler.hs
index 65f3a3d0e..11f96d5fe 100644
--- a/concordium-consensus/src/Concordium/Scheduler.hs
+++ b/concordium-consensus/src/Concordium/Scheduler.hs
@@ -2267,6 +2267,7 @@ handleConfigureDelegation wtc cdCapital cdRestakeEarnings cdDelegationTarget =
         accountStake <- getAccountStake (snd senderAccount)
         arg :: (ConfigureDelegationCont (AccountVersionFor (MPV m))) <- case accountStake of
             AccountStakeNone -> case mDelegatorAdd of
+                Just da | BI.daCapital da == 0 -> rejectTransaction InsufficientDelegationStake
                 Just da -> return (CDCAdd (conditionally flexibleCooldown False) da)
                 Nothing -> rejectTransaction MissingDelegationAddParameters
               where
@@ -2280,6 +2281,7 @@ handleConfigureDelegation wtc cdCapital cdRestakeEarnings cdDelegationTarget =
                     rejectTransaction . AlreadyABaker $
                         ab ^. accountBakerInfo . bieBakerInfo . bakerIdentity
                 STrue -> case mDelegatorAdd of
+                    Just da | BI.daCapital da == 0 -> rejectTransaction InsufficientDelegationStake
                     Just da -> return (CDCAdd (CTrue True) da)
                     Nothing -> rejectTransaction MissingDelegationAddParameters
                   where

From 6eae174b578bf9d480124fe1de2b3260574aee85 Mon Sep 17 00:00:00 2001
From: Emil B <eb@concordium.com>
Date: Tue, 30 Jul 2024 11:24:16 +0200
Subject: [PATCH 44/81] Add more delegation tests.

---
 .../scheduler/SchedulerTests/Delegation.hs    | 203 ++++++++++++++++++
 1 file changed, 203 insertions(+)

diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/Delegation.hs b/concordium-consensus/tests/scheduler/SchedulerTests/Delegation.hs
index 8cdfbb7f4..ac3c3557a 100644
--- a/concordium-consensus/tests/scheduler/SchedulerTests/Delegation.hs
+++ b/concordium-consensus/tests/scheduler/SchedulerTests/Delegation.hs
@@ -153,6 +153,11 @@ delegator3Address = Helpers.accountAddressFromSeed 19
 delegator3KP :: SigScheme.KeyPair
 delegator3KP = Helpers.keyPairFromSeed 19
 
+dummy3Account ::
+    (IsAccountVersion av, Blob.MonadBlobStore m, AVSupportsDelegation av) =>
+    m (BS.PersistentAccount av)
+dummy3Account = Helpers.makeTestAccountFromSeed 20_000_000 19
+
 -- | Account of the baker 4.
 baker4Account ::
     (IsAccountVersion av, Blob.MonadBlobStore m, AVSupportsDelegation av) =>
@@ -162,6 +167,14 @@ baker4Account = makeTestBakerV1FromSeed 1_000_000 1_000 bakerId seed
     bakerId = 4
     seed = 20
 
+-- | Account address of the delegator3.
+baker4Address :: AccountAddress
+baker4Address = Helpers.accountAddressFromSeed 20
+
+-- | Account keys of the delegator3 account.
+baker4KP :: SigScheme.KeyPair
+baker4KP = Helpers.keyPairFromSeed 20
+
 -- | Create initial block state with account
 --  account index 0 is baker0
 --  account index 1 is delegator 1 (delegates to baker 0 with overdelegation)
@@ -180,6 +193,23 @@ initialBlockState =
           baker4Account
         ]
 
+-- | Create initial block state with account
+--  account index 0 is baker0
+--  account index 1 is delegator 1 (delegates to baker 0 with overdelegation)
+--  account index 2 is baker 2
+--  account index 4 is baker 4
+initialBlockState2 ::
+    (IsProtocolVersion pv, PVSupportsDelegation pv) =>
+    Helpers.PersistentBSM pv (BS.HashedPersistentBlockState pv)
+initialBlockState2 =
+    Helpers.createTestBlockStateWithAccountsM
+        [ baker0Account,
+          delegator1Account,
+          baker2Account,
+          dummy3Account,
+          baker4Account
+        ]
+
 -- | Test removing a delegator even if the stake is over the threshold.
 testCase1 ::
     forall pv.
@@ -538,6 +568,175 @@ testCase9 _ pvString =
     checkState result blockState =
         Helpers.assertBlockStateInvariantsH blockState (Helpers.srExecutionCosts result)
 
+-- | Add delegator successfully.
+testCase10 ::
+    forall pv.
+    (IsProtocolVersion pv, PVSupportsDelegation pv) =>
+    SProtocolVersion pv ->
+    String ->
+    Spec
+testCase10 _ pvString =
+    specify (pvString ++ ": Add delegator successfully.") $ do
+        let transactions =
+                [ Runner.TJSON
+                    { payload =
+                        Runner.ConfigureDelegation
+                            { cdCapital = Just 1_000,
+                              cdRestakeEarnings = Just False,
+                              cdDelegationTarget = Just (DelegateToBaker 2)
+                            },
+                      metadata = makeDummyHeader delegator3Address 1 1_000,
+                      keys = [(0, [(0, delegator3KP)])]
+                    }
+                ]
+        (result, doBlockStateAssertions) <-
+            Helpers.runSchedulerTestTransactionJson
+                Helpers.defaultTestConfig
+                (initialBlockState2 @pv)
+                (Helpers.checkReloadCheck checkState)
+                transactions
+        Helpers.assertSuccessWithEvents events result
+        doBlockStateAssertions
+  where
+    checkState ::
+        Helpers.SchedulerResult ->
+        BS.PersistentBlockState pv ->
+        Helpers.PersistentBSM pv Assertion
+    checkState result blockState =
+        Helpers.assertBlockStateInvariantsH blockState (Helpers.srExecutionCosts result)
+    events =
+        [ DelegationAdded 3 delegator3Address,
+          DelegationSetDelegationTarget 3 delegator3Address (DelegateToBaker 2),
+          DelegationSetRestakeEarnings 3 delegator3Address False,
+          DelegationStakeIncreased 3 delegator3Address 1_000
+        ]
+
+-- | Add delegator with 0 stake should get rejected.
+testCase10A ::
+    forall pv.
+    (IsProtocolVersion pv, PVSupportsDelegation pv) =>
+    SProtocolVersion pv ->
+    String ->
+    Spec
+testCase10A _ pvString =
+    specify (pvString ++ ": Add delegator with 0 stake should get rejected.") $ do
+        let transactions =
+                [ Runner.TJSON
+                    { payload =
+                        Runner.ConfigureDelegation
+                            { cdCapital = Just 0,
+                              cdRestakeEarnings = Just False,
+                              cdDelegationTarget = Just (DelegateToBaker 2)
+                            },
+                      metadata = makeDummyHeader delegator3Address 1 1_000,
+                      keys = [(0, [(0, delegator3KP)])]
+                    }
+                ]
+        (result, doBlockStateAssertions) <-
+            Helpers.runSchedulerTestTransactionJson
+                Helpers.defaultTestConfig
+                (initialBlockState2 @pv)
+                (Helpers.checkReloadCheck checkState)
+                transactions
+        Helpers.assertRejectWithReason InsufficientDelegationStake result
+        doBlockStateAssertions
+  where
+    checkState ::
+        Helpers.SchedulerResult ->
+        BS.PersistentBlockState pv ->
+        Helpers.PersistentBSM pv Assertion
+    checkState result blockState =
+        Helpers.assertBlockStateInvariantsH blockState (Helpers.srExecutionCosts result)
+
+-- | Add delegator when already baker. Should get rejected in protocols <= P6 and accepted from P7.
+testCase11 ::
+    forall pv.
+    (IsProtocolVersion pv, PVSupportsDelegation pv) =>
+    SProtocolVersion pv ->
+    String ->
+    Spec
+testCase11 spv pvString =
+    specify (pvString ++ ": Add delegator when already baker.") $ do
+        let transactions =
+                [ Runner.TJSON
+                    { payload =
+                        Runner.ConfigureDelegation
+                            { cdCapital = Just 1_000,
+                              cdRestakeEarnings = Just False,
+                              cdDelegationTarget = Just (DelegateToBaker 2)
+                            },
+                      metadata = makeDummyHeader baker4Address 1 1_000,
+                      keys = [(0, [(0, baker4KP)])]
+                    }
+                ]
+        (result, doBlockStateAssertions) <-
+            Helpers.runSchedulerTestTransactionJson
+                Helpers.defaultTestConfig
+                (initialBlockState2 @pv)
+                (Helpers.checkReloadCheck checkState)
+                transactions
+        let successOrReject :: Assertion
+            successOrReject = case sSupportsFlexibleCooldown (sAccountVersionFor spv) of
+                SFalse -> Helpers.assertRejectWithReason (AlreadyABaker 4) result
+                STrue -> Helpers.assertSuccessWithEvents events result
+        successOrReject
+        doBlockStateAssertions
+  where
+    checkState ::
+        Helpers.SchedulerResult ->
+        BS.PersistentBlockState pv ->
+        Helpers.PersistentBSM pv Assertion
+    checkState result blockState =
+        Helpers.assertBlockStateInvariantsH blockState (Helpers.srExecutionCosts result)
+    events =
+        [ BakerRemoved 4 baker4Address,
+          DelegationAdded 4 baker4Address,
+          DelegationSetDelegationTarget 4 baker4Address (DelegateToBaker 2),
+          DelegationSetRestakeEarnings 4 baker4Address False,
+          DelegationStakeIncreased 4 baker4Address 1_000
+        ]
+
+-- | Add delegator with 0 stake when already a baker should get rejected with
+--  `AlreadyABaker` in protocols <= P6 and `InsufficientDelegationStake` from P7.
+testCase11A ::
+    forall pv.
+    (IsProtocolVersion pv, PVSupportsDelegation pv) =>
+    SProtocolVersion pv ->
+    String ->
+    Spec
+testCase11A spv pvString =
+    specify (pvString ++ ": Add delegator with 0 stake when already baker should get rejected.") $ do
+        let transactions =
+                [ Runner.TJSON
+                    { payload =
+                        Runner.ConfigureDelegation
+                            { cdCapital = Just 0,
+                              cdRestakeEarnings = Just False,
+                              cdDelegationTarget = Just (DelegateToBaker 2)
+                            },
+                      metadata = makeDummyHeader baker4Address 1 1_000,
+                      keys = [(0, [(0, baker4KP)])]
+                    }
+                ]
+        (result, doBlockStateAssertions) <-
+            Helpers.runSchedulerTestTransactionJson
+                Helpers.defaultTestConfig
+                (initialBlockState2 @pv)
+                (Helpers.checkReloadCheck checkState)
+                transactions
+        let reason = case sSupportsFlexibleCooldown (sAccountVersionFor spv) of
+                SFalse -> AlreadyABaker 4
+                STrue -> InsufficientDelegationStake
+        Helpers.assertRejectWithReason reason result
+        doBlockStateAssertions
+  where
+    checkState ::
+        Helpers.SchedulerResult ->
+        BS.PersistentBlockState pv ->
+        Helpers.PersistentBSM pv Assertion
+    checkState result blockState =
+        Helpers.assertBlockStateInvariantsH blockState (Helpers.srExecutionCosts result)
+
 tests :: Spec
 tests =
     describe "Delegate in different scenarios" $
@@ -558,3 +757,7 @@ tests =
                 testCase7 spv pvString
                 testCase8 spv pvString
                 testCase9 spv pvString
+                testCase10 spv pvString
+                testCase10A spv pvString
+                testCase11 spv pvString
+                testCase11A spv pvString

From 7fef710892f6d1dc473e3ce28325e6f2645aa592 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Tue, 30 Jul 2024 14:04:16 +0200
Subject: [PATCH 45/81] Revert move of migratePersistentActiveBakers.

---
 CHANGELOG.md                                  |  7 +++
 .../GlobalState/Persistent/Bakers.hs          | 51 ++++++++++++++++++-
 .../GlobalState/Persistent/BlockState.hs      | 39 --------------
 3 files changed, 57 insertions(+), 40 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index ec896e796..80300c082 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -19,6 +19,13 @@
   prevents encrypting further CCDs or transferring encrypted CCDs.
   `TransferToPublic` remains enabled, allowing existing encrypted balances to be
   decrypted.
+- Changes to stake cooldown behavior in protocol version 7:
+  - When stake is reduced or removed from a validator or delegator, it becomes
+    inactive, and is not counted for future stake calculations. The inactive
+    stake is not spendable, but is released after a cooldown period elapses.
+  - Changes to validators and delegators can be made while stake is in cooldown,
+    including changing the stake, or changing directly between validator and
+    delegator.
 
 ## 6.3.1
 
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Bakers.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Bakers.hs
index 24cc609a8..5e9d6c9c9 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Bakers.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Bakers.hs
@@ -36,6 +36,7 @@ import Concordium.Utils.Serialization
 
 import qualified Concordium.Crypto.SHA256 as H
 import Concordium.GlobalState.Basic.BlockState.LFMBTree (hashAsLFMBTV1)
+import qualified Concordium.GlobalState.Persistent.Accounts as Accounts
 import qualified Concordium.GlobalState.Persistent.Trie as Trie
 import Concordium.Types.HashableTo
 import Concordium.Utils.Serialization.Put
@@ -283,7 +284,10 @@ delegatorTotalCapital :: (AVSupportsDelegation av) => Lens' (PersistentActiveDel
 delegatorTotalCapital f (PersistentActiveDelegatorsV1{..}) =
     (\newDTC -> PersistentActiveDelegatorsV1{adDelegatorTotalCapital = newDTC, ..}) <$> f adDelegatorTotalCapital
 
--- | See documentation of @migratePersistentBlockState@.
+-- | Migrate the representation of a set of delegators to a particular pool.
+-- In most cases, the migration is trivial, and the resulting structure is the same.
+-- In the case of 'StateMigrationParametersP3ToP4', the set of delegators is introduced as empty,
+-- and the total capital is introduced at 0.
 migratePersistentActiveDelegators ::
     (BlobStorable m (), BlobStorable (t m) (), MonadTrans t) =>
     StateMigrationParameters oldpv pv ->
@@ -408,6 +412,51 @@ data PersistentActiveBakers (av :: AccountVersion) = PersistentActiveBakers
 
 makeLenses ''PersistentActiveBakers
 
+-- | Migrate the representation of the active bakers and delegators on protocol update.
+--  In most cases, the migration is trivial, and the resulting structure is the same.
+--  The exception is migrating from P3 to P4 (where delegation is introduced), where
+--  each pool's delegators are introduced as empty, and delegated capital is introduced at 0.
+--  In that case, the total active capital is computed by summing the baker stake amounts
+--  from the supplied accounts table.
+migratePersistentActiveBakers ::
+    forall oldpv pv t m.
+    ( IsProtocolVersion oldpv,
+      IsProtocolVersion pv,
+      SupportMigration m t,
+      Accounts.SupportsPersistentAccount pv (t m)
+    ) =>
+    StateMigrationParameters oldpv pv ->
+    -- | Already migrated accounts.
+    Accounts.Accounts pv ->
+    PersistentActiveBakers (AccountVersionFor oldpv) ->
+    t m (PersistentActiveBakers (AccountVersionFor pv))
+migratePersistentActiveBakers migration accounts PersistentActiveBakers{..} = do
+    newActiveBakers <- Trie.migrateTrieN True (migratePersistentActiveDelegators migration) _activeBakers
+    newAggregationKeys <- Trie.migrateTrieN True return _aggregationKeys
+    newPassiveDelegators <- migratePersistentActiveDelegators migration _passiveDelegators
+    bakerIds <- Trie.keysAsc newActiveBakers
+    bakerStakedAmount <-
+        foldM
+            ( \acc (BakerId aid) ->
+                Accounts.indexedAccount aid accounts >>= \case
+                    Nothing -> error "Baker account does not exist."
+                    Just pa ->
+                        accountBakerStakeAmount pa >>= \case
+                            Nothing -> error "Baker account not a baker."
+                            Just amt -> return $! (acc + amt)
+            )
+            0
+            bakerIds
+    let newTotalActiveCapital = migrateTotalActiveCapital migration bakerStakedAmount _totalActiveCapital
+    return
+        PersistentActiveBakers
+            { _activeBakers = newActiveBakers,
+              _aggregationKeys = newAggregationKeys,
+              _passiveDelegators = newPassiveDelegators,
+              _totalActiveCapital = newTotalActiveCapital
+            }
+
+-- | Construct a 'PersistentActiveBakers' with no bakers or delegators.
 emptyPersistentActiveBakers :: forall av. (IsAccountVersion av) => PersistentActiveBakers av
 emptyPersistentActiveBakers = case delegationSupport @av of
     SAVDelegationSupported ->
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
index d2fc17d18..0c6543c3b 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
@@ -201,45 +201,6 @@ migrateSeedStateV1Trivial SeedStateV1{..} =
     -- at the trigger block from the previous consensus.
     newNonce = H.hash $ "Regenesis" <> encode ss1UpdatedNonce
 
--- | See documentation of @migratePersistentBlockState@.
-migratePersistentActiveBakers ::
-    forall oldpv pv t m.
-    ( IsProtocolVersion oldpv,
-      IsProtocolVersion pv,
-      SupportMigration m t,
-      SupportsPersistentAccount pv (t m)
-    ) =>
-    StateMigrationParameters oldpv pv ->
-    -- | Already migrated accounts.
-    Accounts.Accounts pv ->
-    PersistentActiveBakers (AccountVersionFor oldpv) ->
-    t m (PersistentActiveBakers (AccountVersionFor pv))
-migratePersistentActiveBakers migration accounts PersistentActiveBakers{..} = do
-    newActiveBakers <- Trie.migrateTrieN True (migratePersistentActiveDelegators migration) _activeBakers
-    newAggregationKeys <- Trie.migrateTrieN True return _aggregationKeys
-    newPassiveDelegators <- migratePersistentActiveDelegators migration _passiveDelegators
-    bakerIds <- Trie.keysAsc newActiveBakers
-    totalStakedAmount <-
-        foldM
-            ( \acc (BakerId aid) ->
-                Accounts.indexedAccount aid accounts >>= \case
-                    Nothing -> error "Baker account does not exist."
-                    Just pa ->
-                        accountBakerStakeAmount pa >>= \case
-                            Nothing -> error "Baker account not a baker."
-                            Just amt -> return $! (acc + amt)
-            )
-            0
-            bakerIds
-    let newTotalActiveCapital = migrateTotalActiveCapital migration totalStakedAmount _totalActiveCapital
-    return
-        PersistentActiveBakers
-            { _activeBakers = newActiveBakers,
-              _aggregationKeys = newAggregationKeys,
-              _passiveDelegators = newPassiveDelegators,
-              _totalActiveCapital = newTotalActiveCapital
-            }
-
 -- | See documentation of @migratePersistentBlockState@.
 --
 --  Migrate the birk parameters assuming accounts have already been migrated.

From a4419d1737fd07d3c70e6c33a8d38a74a26c9947 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Tue, 30 Jul 2024 14:38:03 +0200
Subject: [PATCH 46/81] Require non-zero stake for baker, even if minimum
 threshold is set at 0.

---
 .../src/Concordium/GlobalState/BlockState.hs                | 3 ++-
 .../src/Concordium/GlobalState/Persistent/Bakers.hs         | 4 +++-
 .../src/Concordium/GlobalState/Persistent/BlockState.hs     | 6 +++---
 3 files changed, 8 insertions(+), 5 deletions(-)

diff --git a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs
index 2e2436bce..bd5d99815 100644
--- a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs
@@ -1129,7 +1129,8 @@ class (BlockStateQuery m) => BlockStateOperations m where
     --  * the account is valid;
     --  * the account is not a baker;
     --  * the account is not a delegator;
-    --  * the delegated amount does not exceed the account's balance.
+    --  * the delegated amount does not exceed the account's balance;
+    --  * the delegated stake is > 0.
     --
     --  The function behaves as follows:
     --
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Bakers.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Bakers.hs
index 5e9d6c9c9..0d1867267 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Bakers.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Bakers.hs
@@ -280,9 +280,11 @@ data PersistentActiveDelegators (av :: AccountVersion) where
         } ->
         PersistentActiveDelegators av
 
+-- | Lens to access the total capital of the delegators to the pool.
 delegatorTotalCapital :: (AVSupportsDelegation av) => Lens' (PersistentActiveDelegators av) Amount
 delegatorTotalCapital f (PersistentActiveDelegatorsV1{..}) =
-    (\newDTC -> PersistentActiveDelegatorsV1{adDelegatorTotalCapital = newDTC, ..}) <$> f adDelegatorTotalCapital
+    (\newDTC -> PersistentActiveDelegatorsV1{adDelegatorTotalCapital = newDTC, ..})
+        <$> f adDelegatorTotalCapital
 
 -- | Migrate the representation of a set of delegators to a particular pool.
 -- In most cases, the migration is trivial, and the resulting structure is the same.
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
index 0c6543c3b..200f18570 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
@@ -1435,7 +1435,7 @@ doAddBaker pbs ai ba@BakerAdd{..} = do
             -- Account is not a baker
             | otherwise -> do
                 cp <- (^. cpPoolParameters . ppBakerStakeThreshold) <$> lookupCurrentParameters (bspUpdates bsp)
-                if baStake < cp
+                if baStake < max 1 cp
                     then return (BAStakeUnderThreshold, pbs)
                     else do
                         let bid = BakerId ai
@@ -1497,7 +1497,7 @@ addValidatorChecks bsp ValidatorAdd{..} = do
         capitalMin = poolParams ^. ppMinimumEquityCapital
         ranges = poolParams ^. ppCommissionBounds
     -- Check if the equity capital is below the minimum threshold.
-    when (vaCapital < capitalMin) $ MTL.throwError VCFStakeUnderThreshold
+    when (vaCapital < max 1 capitalMin) $ MTL.throwError VCFStakeUnderThreshold
     -- Check if the transaction fee commission rate is in the acceptable range.
     unless
         ( isInRange
@@ -2289,7 +2289,7 @@ doUpdateBakerStake pbs ai newStake = do
                             storePBS pbs bsp{bspAccounts = newAccounts}
                     case compare newStake sdStakedCapital of
                         LT ->
-                            if newStake < bakerStakeThreshold
+                            if newStake < max 1 bakerStakeThreshold
                                 then return (BSUStakeUnderThreshold, pbs)
                                 else
                                     (BSUStakeReduced (BakerId ai) (curEpoch + cooldownEpochs),)

From b4adefbc1e1c51618b4a5468f629be9b5d2e5ca1 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Wed, 31 Jul 2024 13:25:10 +0200
Subject: [PATCH 47/81] Documentation.

---
 .../src/Concordium/GlobalState/BlockState.hs  |  17 +-
 .../GlobalState/Persistent/BlockState.hs      | 284 +++++++++++++++++-
 2 files changed, 292 insertions(+), 9 deletions(-)

diff --git a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs
index bd5d99815..801a3e8c0 100644
--- a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs
@@ -986,7 +986,8 @@ class (BlockStateQuery m) => BlockStateOperations m where
     --
     --  The function behaves as follows:
     --
-    --  1. If the baker's capital is less than the minimum threshold, return 'VCFStakeUnderThreshold'.
+    --  1. If the baker's capital is 0, or less than the minimum threshold, return
+    --     'VCFStakeUnderThreshold'.
     --  2. If the transaction fee commission is not in the acceptable range, return
     --     'VCFTransactionFeeCommissionNotInRange'.
     --  3. If the baking reward commission is not in the acceptable range, return
@@ -1016,7 +1017,7 @@ class (BlockStateQuery m) => BlockStateOperations m where
     --
     --  * the account is valid;
     --  * the account is a baker;
-    --  * if the stake is being updated, then the account balance exceeds the new stake.
+    --  * if the stake is being updated, then the account balance is at least the new stake.
     --
     --  The function behaves as follows, building a list @events@:
     --
@@ -1174,7 +1175,7 @@ class (BlockStateQuery m) => BlockStateOperations m where
     --
     --  1. If the delegation target is specified as @target@:
     --
-    --       (1) If the delegation target is a valid baker that is not 'OpenForAll', return 'DCPoolClosed'.
+    --       (1) If the delegation target is a valid baker that is not 'OpenForAll', return 'DCFPoolClosed'.
     --
     --       (2) If the delegation target is baker id @bid@, but the baker does not exist, return
     --           @DCFInvalidDelegationTarget bid@.
@@ -1221,11 +1222,13 @@ class (BlockStateQuery m) => BlockStateOperations m where
     --
     --             * append @DelegationConfigureStakeIncreased capital@ to @events@.
     --
-    --  4. If the amount delegated to the delegation target exceeds the leverage bound, return
-    --     'DCFPoolStakeOverThreshold' and revert any changes.
+    --  4. If the delegation target has changed or the delegated capital is increased:
     --
-    --  5. If the amount delegated to the delegation target exceed the capital bound, return
-    --     'DCFPoolOverDelegated' and revert any changes.
+    --            * If the amount delegated to the delegation target exceeds the leverage bound,
+    --              return 'DCFPoolStakeOverThreshold' and revert any changes.
+    --
+    --            * If the amount delegated to the delegation target exceed the capital bound,
+    --              return 'DCFPoolOverDelegated' and revert any changes.
     --
     --  6. Return @events@ with the updated state.
     bsoUpdateDelegator ::
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
index 200f18570..c8b3a9244 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
@@ -1482,6 +1482,20 @@ redelegatePassive accounts (DelegatorId accId) =
         accId
         accounts
 
+-- | Check the conditions required for successfully adding a validator.
+--  This function does not modify the block state.
+--
+--  The function behaves as follows:
+--
+--  1. If the baker's capital is 0, or less than the minimum threshold, throw
+--     'VCFStakeUnderThreshold'.
+--  2. If the transaction fee commission is not in the acceptable range, throw
+--     'VCFTransactionFeeCommissionNotInRange'.
+--  3. If the baking reward commission is not in the acceptable range, throw
+--     'VCFBakingRewardCommissionNotInRange'.
+--  4. If the finalization reward commission is not in the acceptable range, throw
+--     'VCFFinalizationRewardCommissionNotInRange'.
+--  5. If the aggregation key is a duplicate, throw 'VCFDuplicateAggregationKey'.
 addValidatorChecks ::
     forall pv m.
     ( SupportsPersistentState pv m,
@@ -1525,8 +1539,36 @@ addValidatorChecks bsp ValidatorAdd{..} = do
     when existingAggKey $
         MTL.throwError (VCFDuplicateAggregationKey (bkuAggregationKey vaKeys))
 
--- |
--- PRECONDITION: The account exists and is not currently a baker or delegator.
+-- | From chain parameters version >= 1, this adds a validator for an account. This is used to
+--  implement 'bsoAddValidator'.
+--
+--  PRECONDITIONS:
+--
+--  * the account is valid;
+--  * the account is not a baker;
+--  * the account is not a delegator;
+--  * the account has sufficient balance to cover the stake.
+--
+--  The function behaves as follows:
+--
+--  1. If the baker's capital is 0, or less than the minimum threshold, return
+--     'VCFStakeUnderThreshold'.
+--  2. If the transaction fee commission is not in the acceptable range, return
+--     'VCFTransactionFeeCommissionNotInRange'.
+--  3. If the baking reward commission is not in the acceptable range, return
+--     'VCFBakingRewardCommissionNotInRange'.
+--  4. If the finalization reward commission is not in the acceptable range, return
+--     'VCFFinalizationRewardCommissionNotInRange'.
+--  5. If the aggregation key is a duplicate, return 'VCFDuplicateAggregationKey'.
+--  6. Add the baker to the account. If flexible cooldowns are supported by the protocol
+--     version, then the capital in cooldown is reactivated. The indexes are updated as follows:
+--
+--       * add an empty pool for the baker in the active bakers;
+--       * add the baker's equity capital to the total active capital;
+--       * add the baker's aggregation key to the aggregation key set;
+--       * the cooldown indexes are updated to reflect any reactivation of capital.
+--
+--  7. Return the updated block state.
 newAddValidator ::
     forall pv m.
     ( SupportsPersistentState pv m,
@@ -1585,12 +1627,36 @@ newAddValidator pbs ai va@ValidatorAdd{..} = do
     bid = BakerId ai
     flexibleCooldowns = sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv))
 
+-- | Check the conditions required for successfully updating a validator. This does not modify
+--  the block state.
+--
+--  1. If keys are supplied: if the aggregation key duplicates an existing aggregation key @key@
+--     (except the accounts's current aggregation key), throw @VCFDuplicateAggregationKey key@.
+--
+--  2. If the transaction fee commission is supplied, and the commission does not fall within the
+--     current range according to the chain parameters, throw
+--     @VCFTransactionFeeCommissionNotInRange@.
+--
+--  3. If the baking reward commission is supplied, and the commission does not fall within the
+--     current range according to the chain parameters, throw @VCFBakingRewardCommissionNotInRange@.
+--
+--  4. If the finalization reward commission is supplied, and the commission does not fall within
+--     the current range according to the chain parameters, throw
+--     @VCFFinalizationRewardCommissionNotInRange@.
+--
+--  5. If the capital is supplied:
+--
+--       * If there is a pending change to the baker's capital, throw @VCFChangePending@.
+--
+--       * If the capital is non-zero, and less than the current minimum equity capital, throw
+--         @BCStakeUnderThreshold@.
 updateValidatorChecks ::
     forall pv m.
     ( SupportsPersistentState pv m,
       PoolParametersVersionFor (ChainParametersVersionFor pv) ~ 'PoolParametersVersion1
     ) =>
     BlockStatePointers pv ->
+    -- | The current baker on the account being updated
     AccountBaker (AccountVersionFor pv) ->
     ValidatorUpdate ->
     MTL.ExceptT ValidatorConfigureFailure m ()
@@ -1627,6 +1693,99 @@ updateValidatorChecks bsp baker ValidatorUpdate{..} = do
         when (capital /= 0 && capital < capitalMin) $
             MTL.throwError VCFStakeUnderThreshold
 
+-- | Update the validator for an account.
+--
+--  PRECONDITIONS:
+--
+--  * the account is valid;
+--  * the account is a baker;
+--  * if the stake is being updated, then the account balance is at least the new stake.
+--
+--  The function behaves as follows, building a list @events@:
+--
+--  1. If keys are supplied: if the aggregation key duplicates an existing aggregation key @key@
+--     (except the accounts's current aggregation key), return @VCFDuplicateAggregationKey key@;
+--     otherwise, update the keys with the supplied @keys@, update the aggregation key index
+--     (removing the old key and adding the new one), and append @BakerConfigureUpdateKeys keys@
+--     to @events@.
+--
+--  2. If the restake earnings flag is supplied: update the account's flag to the supplied value
+--     @restakeEarnings@ and append @BakerConfigureRestakeEarnings restakeEarnings@ to @events@.
+--
+--  3. If the open-for-delegation configuration is supplied:
+--
+--         (1) update the account's configuration to the supplied value @openForDelegation@;
+--
+--         (2) if @openForDelegation == ClosedForAll@, transfer all delegators in the baker's pool to
+--             passive delegation; and
+--
+--         (3) append @BakerConfigureOpenForDelegation openForDelegation@ to @events@.
+--
+--  4. If the metadata URL is supplied: update the account's metadata URL to the supplied value
+--     @metadataURL@ and append @BakerConfigureMetadataURL metadataURL@ to @events@.
+--
+--  5. If the transaction fee commission is supplied:
+--
+--        (1) if the commission does not fall within the current range according to the chain
+--            parameters, return @VCFTransactionFeeCommissionNotInRange@; otherwise,
+--
+--        (2) update the account's transaction fee commission rate to the the supplied value @tfc@;
+--
+--        (3) append @BakerConfigureTransactionFeeCommission tfc@ to @events@.
+--
+--  6. If the baking reward commission is supplied:
+--
+--        (1) if the commission does not fall within the current range according to the chain
+--            parameters, return @VCFBakingRewardCommissionNotInRange@; otherwise,
+--
+--        (2) update the account's baking reward commission rate to the the supplied value @brc@;
+--
+--        (3) append @BakerConfigureBakingRewardCommission brc@ to @events@.
+--
+--  6. If the finalization reward commission is supplied:
+--
+--        (1) if the commission does not fall within the current range according to the chain
+--            parameters, return @VCFFinalizationRewardCommissionNotInRange@; otherwise,
+--
+--        (2) update the account's finalization reward commission rate to the the supplied value @frc@;
+--
+--        (3) append @BakerConfigureFinalizationRewardCommission frc@ to @events@.
+--
+--  7. If the capital is supplied: if there is a pending change to the baker's capital, return
+--     @VCFChangePending@; otherwise:
+--
+--       * if the capital is 0
+--
+--           - (< P7) mark the baker as pending removal at @bcuSlotTimestamp@ plus the
+--           the current baker cooldown period according to the chain parameters
+--
+--           - (>= P7) transfer the existing staked capital to pre-pre-cooldown, and mark the
+--           account as in pre-pre-cooldown (in the global index) if it wasn't already
+--
+--           - append @BakerConfigureStakeReduced 0@ to @events@;
+--
+--       * if the capital is less than the current minimum equity capital, return @BCStakeUnderThreshold@;
+--
+--       * if the capital is (otherwise) less than the current equity capital of the baker
+--
+--           - (< P7) mark the baker as pending stake reduction to the new capital at
+--             @bcuSlotTimestamp@ plus the current baker cooldown period according to the chain
+--             parameters
+--
+--           - (>= P7) transfer the decrease in staked capital to pre-pre-cooldown, and mark the
+--             account as in pre-pre-cooldown (in the global index) if it wasn't already
+--
+--           - append @BakerConfigureStakeReduced capital@ to @events@;
+--
+--       * if the capital is equal to the baker's current equity capital, do nothing, append
+--         @BakerConfigureStakeIncreased capital@ to @events@;
+--
+--       * if the capital is greater than the baker's current equity capital, increase the baker's
+--         equity capital to the new capital (updating the total active capital in the active baker
+--         index by adding the difference between the new and old capital) and append
+--         @BakerConfigureStakeIncreased capital@ to @events@.
+--
+--  8. Return @events@ with the updated block state.
 newUpdateValidator ::
     forall pv m.
     ( SupportsPersistentState pv m,
@@ -1893,6 +2052,39 @@ addDelegatorChecks bsp DelegatorAdd{daDelegationTarget = Transactions.DelegateTo
   where
     BakerId baid = bid
 
+-- \| From chain parameters version >= 1, this operation is used to add a delegator.
+--  When adding delegator, it is assumed that 'AccountIndex' account is NOT a baker and NOT a delegator.
+--
+--  PRECONDITIONS:
+--
+--  * the account is valid;
+--  * the account is not a baker;
+--  * the account is not a delegator;
+--  * the delegated amount does not exceed the account's balance;
+--  * the delegated stake is > 0.
+--
+--  The function behaves as follows:
+--
+--  1. If the delegation target is a valid baker that is not 'OpenForAll', return 'DCFPoolClosed'.
+--
+--  2. If the delegation target is baker id @bid@, but the baker does not exist, return
+--     @DCFInvalidDelegationTarget bid@.
+--
+--  3. Update the active bakers index to record:
+--
+--       * the delegator delegates to the target pool;
+--       * the target pool's delegated capital is increased by the delegated amount;
+--       * the total active capital is increased by the delegated amount.
+--
+--  4. Update the account to record the specified delegation.
+--
+--  5. If the amount delegated to the delegation target exceeds the leverage bound, return
+--     'DCFPoolStakeOverThreshold' and revert any changes.
+--
+--  6. If the amount delegated to the delegation target exceed the capital bound, return
+--     'DCFPoolOverDelegated' and revert any changes.
+--
+--  7. Return the updated state.
 newAddDelegator ::
     forall pv m.
     ( SupportsPersistentState pv m,
@@ -1955,6 +2147,24 @@ newAddDelegator pbs ai da@DelegatorAdd{..} = do
               _delegationIdentity = did
             }
 
+-- | Check the conditions required to successfully update a delegator.
+--
+--  1. If the delegation target is neither passive nor a valid baker, throw
+--     'DCFInvalidDelegationTarget'.
+--
+--  2. If the delegation target is a valid baker, but the pool is not open for all, throw
+--     'DCFPoolClosed'.
+--
+--  3. If the delegated capital is specified and there is a pending change to the delegator's
+--     stake, throw 'DCFChangePending'.
+--
+--  4. If the delegation target is being changed or the delegated capital is being increased:
+--
+--            * If the amount delegated to the delegation target would exceed the leverage bound,
+--              throw 'DCFPoolStakeOverThreshold'.
+--
+--            * If the amount delegated to the delegation target would exceed the capital bound,
+--              throw 'DCFPoolOverDelegated'.
 updateDelegatorChecks ::
     forall pv m.
     ( IsProtocolVersion pv,
@@ -1964,6 +2174,7 @@ updateDelegatorChecks ::
       PoolParametersVersionFor (ChainParametersVersionFor pv) ~ 'PoolParametersVersion1
     ) =>
     BlockStatePointers pv ->
+    -- | The current delegation status of the account.
     BaseAccounts.AccountDelegation (AccountVersionFor pv) ->
     DelegatorUpdate ->
     m ()
@@ -2028,6 +2239,75 @@ updateDelegatorChecks bsp oldDelegator DelegatorUpdate{..} = do
   where
     flexibleCooldown = sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv))
 
+-- | From chain parameters version >= 1, this operation is used to update or remove a delegator.
+--  This is used to implement 'bsoUpdateDelegator'.
+--
+--  PRECONDITIONS:
+--
+--  * the account is valid;
+--  * the account is a delegator;
+--  * if the delegated amount is updated, it does not exceed the account's balance.
+--
+--  The function behaves as follows, building a list @events@:
+--
+--  1. If the delegation target is specified as @target@:
+--
+--       (1) If the delegation target is a valid baker that is not 'OpenForAll', return 'DCFPoolClosed'.
+--
+--       (2) If the delegation target is baker id @bid@, but the baker does not exist, return
+--           @DCFInvalidDelegationTarget bid@.
+--
+--       (3) Update the active bakers index to: remove the delegator and delegated amount from the
+--           old baker pool, and add the delegator and delegated amount to the new baker pool.
+--           (Note, the total delegated amount is unchanged at this point.)
+--
+--       (4) Update the account to record the new delegation target.
+--
+--       (5) Append @DelegationConfigureDelegationTarget target@ to @events@. [N.B. if the target is
+--           pool is the same as the previous value, steps (1)-(4) will do nothing and may be skipped
+--           by the implementation. This relies on the invariant that delegators delegate only to
+--           valid pools.]
+--
+--  2. If the "restake earnings" flag is specified as @restakeEarnings@:
+--
+--       (1) Update the restake earnings flag on the account to match @restakeEarnings@.
+--
+--       (2) Append @DelegationConfigureRestakeEarnings restakeEarnings@ to @events@.
+--
+--  3. If the delegated capital is specified as @capital@: if there is a pending change to the
+--     delegator's stake, return 'DCFChangePending'; otherwise:
+--
+--       * If the new capital is 0, mark the delegator as pending removal at the slot timestamp
+--         plus the delegator cooldown chain parameter, and append
+--         @DelegationConfigureStakeReduced capital@ to @events@; otherwise
+--
+--       * If the the new capital is less than the current staked capital (but not 0), mark the
+--         delegator as pending stake reduction to @capital@ at the slot timestamp plus the
+--         delegator cooldown chain parameter, and append @DelegationConfigureStakeReduced capital@
+--         to @events@;
+--
+--       * If the new capital is equal to the current staked capital, append
+--         @DelegationConfigureStakeIncreased capital@ to @events@.
+--
+--       * If the new capital is greater than the current staked capital by @delta > 0@:
+--
+--             * increase the total active capital by @delta@,
+--
+--             * increase the delegator's target pool delegated capital by @delta@,
+--
+--             * set the baker's delegated capital to @capital@, and
+--
+--             * append @DelegationConfigureStakeIncreased capital@ to @events@.
+--
+--  4. If the delegation target has changed or the delegated capital is increased:
+--
+--            * If the amount delegated to the delegation target exceeds the leverage bound,
+--              return 'DCFPoolStakeOverThreshold' and revert any changes.
+--
+--            * If the amount delegated to the delegation target exceed the capital bound,
+--              return 'DCFPoolOverDelegated' and revert any changes.
+--
+--  6. Return @events@ with the updated state.
 newUpdateDelegator ::
     forall pv m.
     ( SupportsPersistentState pv m,

From 42efdd5f68146476900f6d35ba7adcdf0a5bccac Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Thu, 1 Aug 2024 17:44:44 +0200
Subject: [PATCH 48/81] Enable P7 testing.

---
 .../tests/consensus/ConcordiumTests/KonsensusV1/Common.hs     | 4 ++--
 .../tests/scheduler/SchedulerTests/Helpers.hs                 | 4 ++--
 2 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/Common.hs b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/Common.hs
index 43d310a42..70544940f 100644
--- a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/Common.hs
+++ b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/Common.hs
@@ -148,8 +148,8 @@ forEveryProtocolVersion check =
           check SP3 "P3",
           check SP4 "P4",
           check SP5 "P5",
-          check SP6 "P6"
-          -- FIXME: check SP7 "P7"
+          check SP6 "P6",
+          check SP7 "P7"
         ]
 
 -- | Run tests for each protocol version using consensus v1 (P6 and onwards).
diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/Helpers.hs b/concordium-consensus/tests/scheduler/SchedulerTests/Helpers.hs
index 2acb0b347..1886d111d 100644
--- a/concordium-consensus/tests/scheduler/SchedulerTests/Helpers.hs
+++ b/concordium-consensus/tests/scheduler/SchedulerTests/Helpers.hs
@@ -133,8 +133,8 @@ forEveryProtocolVersion check =
       check Types.SP3 "P3",
       check Types.SP4 "P4",
       check Types.SP5 "P5",
-      check Types.SP6 "P6"
-      -- FIXME: check Types.SP7 "P7"
+      check Types.SP6 "P6",
+      check Types.SP7 "P7"
     ]
 
 -- | Construct a test block state containing the provided accounts.

From 06b029d0577fa363fa4e18a6a455396e1c6e0676 Mon Sep 17 00:00:00 2001
From: Emil B <eb@concordium.com>
Date: Fri, 2 Aug 2024 11:07:26 +0200
Subject: [PATCH 49/81] Add more tests.

---
 .../scheduler/SchedulerTests/Delegation.hs    | 116 ++++++++++++++++++
 1 file changed, 116 insertions(+)

diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/Delegation.hs b/concordium-consensus/tests/scheduler/SchedulerTests/Delegation.hs
index ac3c3557a..e1fc693f5 100644
--- a/concordium-consensus/tests/scheduler/SchedulerTests/Delegation.hs
+++ b/concordium-consensus/tests/scheduler/SchedulerTests/Delegation.hs
@@ -21,6 +21,7 @@ import Concordium.ID.Types as ID
 import Concordium.Types.Accounts
 
 import Concordium.GlobalState.BakerInfo
+import qualified Concordium.GlobalState.BlockState as BS
 import qualified Concordium.GlobalState.Persistent.Account as BS
 import qualified Concordium.GlobalState.Persistent.BlobStore as Blob
 import qualified Concordium.GlobalState.Persistent.BlockState as BS
@@ -29,8 +30,12 @@ import qualified Concordium.Scheduler.Runner as Runner
 import Concordium.Scheduler.Types
 import qualified Concordium.Scheduler.Types as Types
 
+import Concordium.GlobalState.CooldownQueue
 import Concordium.GlobalState.DummyData
 import Concordium.Scheduler.DummyData
+import Concordium.Types.Option
+import Control.Monad
+import Data.Maybe
 import qualified SchedulerTests.Helpers as Helpers
 import Test.HUnit
 import Test.Hspec
@@ -737,6 +742,116 @@ testCase11A spv pvString =
     checkState result blockState =
         Helpers.assertBlockStateInvariantsH blockState (Helpers.srExecutionCosts result)
 
+-- | Reduce stake while in cooldown.
+testCase12 ::
+    forall pv.
+    (IsProtocolVersion pv, PVSupportsDelegation pv) =>
+    SProtocolVersion pv ->
+    String ->
+    Spec
+testCase12 spv pvString =
+    specify (pvString ++ ": Reduce stake while in cooldown.") $ do
+        let transactionsAndAssertions :: [Helpers.TransactionAndAssertion pv]
+            transactionsAndAssertions =
+                [ Helpers.TransactionAndAssertion
+                    { taaTransaction =
+                        Runner.TJSON
+                            { payload =
+                                Runner.ConfigureDelegation
+                                    { cdCapital = Just 999,
+                                      cdRestakeEarnings = Nothing,
+                                      cdDelegationTarget = Nothing
+                                    },
+                              metadata = makeDummyHeader delegator3Address 1 1_000,
+                              keys = [(0, [(0, delegator3KP)])]
+                            },
+                      taaAssertion = \result _ -> do
+                        return $ do
+                            Helpers.assertSuccessWithEvents
+                                [DelegationStakeDecreased 3 delegator3Address 999]
+                                result
+                    },
+                  Helpers.TransactionAndAssertion
+                    { taaTransaction =
+                        Runner.TJSON
+                            { payload =
+                                Runner.ConfigureDelegation
+                                    { cdCapital = Just 995,
+                                      cdRestakeEarnings = Nothing,
+                                      cdDelegationTarget = Nothing
+                                    },
+                              metadata = makeDummyHeader delegator3Address 2 1_000,
+                              keys = [(0, [(0, delegator3KP)])]
+                            },
+                      taaAssertion = assertPrePreCooldown 5 (DelegationStakeDecreased 3 delegator3Address 995)
+                    },
+                  Helpers.TransactionAndAssertion
+                    { taaTransaction =
+                        Runner.TJSON
+                            { payload =
+                                Runner.ConfigureDelegation
+                                    { cdCapital = Just 998,
+                                      cdRestakeEarnings = Nothing,
+                                      cdDelegationTarget = Nothing
+                                    },
+                              metadata = makeDummyHeader delegator3Address 3 1_000,
+                              keys = [(0, [(0, delegator3KP)])]
+                            },
+                      taaAssertion = assertPrePreCooldown 2 (DelegationStakeIncreased 3 delegator3Address 998)
+                    },
+                  Helpers.TransactionAndAssertion
+                    { taaTransaction =
+                        Runner.TJSON
+                            { payload =
+                                Runner.ConfigureDelegation
+                                    { cdCapital = Just 1000,
+                                      cdRestakeEarnings = Nothing,
+                                      cdDelegationTarget = Nothing
+                                    },
+                              metadata = makeDummyHeader delegator3Address 4 1_000,
+                              keys = [(0, [(0, delegator3KP)])]
+                            },
+                      taaAssertion = assertNoCooldown (DelegationStakeIncreased 3 delegator3Address 1000)
+                    }
+                ]
+        Helpers.runSchedulerTestAssertIntermediateStates
+            @pv
+            Helpers.defaultTestConfig
+            initialBlockState
+            transactionsAndAssertions
+  where
+    assertPrePreCooldown :: Amount -> Event -> Helpers.TransactionAssertion pv
+    assertPrePreCooldown expAmt event result pbs = case sSupportsFlexibleCooldown (sAccountVersionFor spv) of
+        STrue -> do
+            maybeAccount <- BS.bsoGetAccount pbs delegator3Address
+            case maybeAccount of
+                Nothing -> return $ assertFailure $ "Account with address '" ++ show delegator3Address ++ "' not found"
+                Just (_, account) -> do
+                    maybeCooldowns <- BS.accountCooldowns account
+                    let toAssert = case maybeCooldowns of
+                            Nothing -> assertFailure "Account should have been in pre-pre-cooldown"
+                            Just cd -> case prePreCooldown cd of
+                                Absent -> assertFailure "Account should have been in pre-pre cooldown"
+                                Present amt -> assertEqual "Amount in pre-pre-cooldown should be correct" expAmt amt
+                    return $ do
+                        toAssert
+                        Helpers.assertSuccessWithEvents [event] result
+        SFalse ->
+            return $ Helpers.assertRejectWithReason DelegatorInCooldown result
+    assertNoCooldown :: Event -> Helpers.TransactionAssertion pv
+    assertNoCooldown event result pbs = case sSupportsFlexibleCooldown (sAccountVersionFor spv) of
+        STrue -> do
+            maybeAccount <- BS.bsoGetAccount pbs delegator3Address
+            case maybeAccount of
+                Nothing -> return $ assertFailure $ "Account with address '" ++ show delegator3Address ++ "' not found"
+                Just (_, account) -> do
+                    maybeCooldowns <- BS.accountCooldowns account
+                    return $ do
+                        when (isJust maybeCooldowns) $ assertFailure "Account should have no cooldowns"
+                        Helpers.assertSuccessWithEvents [event] result
+        SFalse ->
+            return $ Helpers.assertRejectWithReason DelegatorInCooldown result
+
 tests :: Spec
 tests =
     describe "Delegate in different scenarios" $
@@ -761,3 +876,4 @@ tests =
                 testCase10A spv pvString
                 testCase11 spv pvString
                 testCase11A spv pvString
+                testCase12 spv pvString

From 48a0b3809e8b2dd179142a96c3e6d3078d45ed70 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Fri, 2 Aug 2024 11:16:14 +0200
Subject: [PATCH 50/81] Simplify instance

---
 concordium-consensus/src/Concordium/GlobalState/Account.hs | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/concordium-consensus/src/Concordium/GlobalState/Account.hs b/concordium-consensus/src/Concordium/GlobalState/Account.hs
index e8287e3c9..651e70a1e 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Account.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Account.hs
@@ -7,7 +7,6 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE UndecidableInstances #-}
 
 module Concordium.GlobalState.Account where
 
@@ -557,7 +556,7 @@ data StakeDetails (av :: AccountVersion) where
         } ->
         StakeDetails av
 
-instance (Show (PendingChangeEffective av)) => Show (StakeDetails av) where
+instance Show (StakeDetails av) where
     show StakeDetailsNone = "StakeDetailsNone"
     show StakeDetailsBaker{..} =
         "StakeDetailsBaker {sdStakedCapital = "

From 2a5fa4d140b063a194c26c78117ca1c84209b104 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Fri, 2 Aug 2024 17:19:20 +0200
Subject: [PATCH 51/81] Add global cooldown index. Support P6->P7 migration.

---
 .../GlobalState/Persistent/Account.hs         |  20 +-
 .../Persistent/Account/MigrationState.hs      | 262 +++++++++++++
 .../Account/MigrationStateInterface.hs        |  30 ++
 .../Persistent/Account/StructureV1.hs         | 246 +++++++++++-
 .../GlobalState/Persistent/Accounts.hs        |  25 +-
 .../GlobalState/Persistent/Bakers.hs          |  18 +
 .../GlobalState/Persistent/BlockState.hs      |  68 +++-
 .../GlobalState/Persistent/Cooldown.hs        | 251 ++++++++++++
 .../GlobalState/Persistent/Genesis.hs         |   2 +
 .../GlobalState/Persistent/ReleaseSchedule.hs |  48 ++-
 .../AccountsMigrationP6ToP7.hs                | 368 ++++++++++++++++++
 .../tests/globalstate/Spec.hs                 |   2 +
 12 files changed, 1299 insertions(+), 41 deletions(-)
 create mode 100644 concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationState.hs
 create mode 100644 concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationStateInterface.hs
 create mode 100644 concordium-consensus/src/Concordium/GlobalState/Persistent/Cooldown.hs
 create mode 100644 concordium-consensus/tests/globalstate/GlobalStateTests/AccountsMigrationP6ToP7.hs

diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs
index c707d6362..e1ca93500 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs
@@ -28,6 +28,7 @@ import Concordium.GlobalState.BakerInfo
 import qualified Concordium.GlobalState.Basic.BlockState.Account as Transient
 import Concordium.GlobalState.BlockState (AccountAllowance)
 import Concordium.GlobalState.CooldownQueue
+import Concordium.GlobalState.Persistent.Account.MigrationStateInterface
 import qualified Concordium.GlobalState.Persistent.Account.StructureV0 as V0
 import qualified Concordium.GlobalState.Persistent.Account.StructureV1 as V1
 import Concordium.GlobalState.Persistent.BlobStore
@@ -647,11 +648,26 @@ makePersistentBakerInfoRef = case accountVersion @av of
 -- * Migration
 
 -- | Migrate a 'PersistentAccount' between protocol versions according to a state migration.
+--
+--  When migrating P6->P7 (account version 2 to 3), the 'AccountMigration' interface is used as
+--  follows:
+--
+--   * Accounts that previously had a pending change are updated to have a pre-pre-cooldown, and
+--     'addAccountInPrePreCooldown' is called. If the pending change is a reduction in stake,
+--     the reduction is applied immediately to the active stake. If the pending change is a removal,
+--     the baker or delegator record is removed altogether.
+--
+--   * Accounts that are still delegating but were delegating to a baker for which 'isBakerRemoved'
+--     returns @True@ are updated to delegate to passive delegation.
+--
+--   * For accounts that are still delegating, 'retainDelegator' is called to record the (new)
+--     delegation amount and target.
 migratePersistentAccount ::
     forall oldpv pv t m.
     ( IsProtocolVersion oldpv,
       IsProtocolVersion pv,
-      SupportMigration m t
+      SupportMigration m t,
+      AccountMigration (AccountVersionFor pv) (t m)
     ) =>
     StateMigrationParameters oldpv pv ->
     PersistentAccount (AccountVersionFor oldpv) ->
@@ -659,7 +675,7 @@ migratePersistentAccount ::
 migratePersistentAccount m@StateMigrationParametersTrivial (PAV0 acc) = PAV0 <$> V0.migratePersistentAccount m acc
 migratePersistentAccount m@StateMigrationParametersTrivial (PAV1 acc) = PAV1 <$> V0.migratePersistentAccount m acc
 migratePersistentAccount m@StateMigrationParametersTrivial (PAV2 acc) = PAV2 <$> V1.migratePersistentAccount m acc
-migratePersistentAccount StateMigrationParametersTrivial (PAV3 _) = undefined -- TODO: Implement migration
+migratePersistentAccount m@StateMigrationParametersTrivial (PAV3 acc) = PAV3 <$> V1.migratePersistentAccount m acc
 migratePersistentAccount m@StateMigrationParametersP1P2 (PAV0 acc) = PAV0 <$> V0.migratePersistentAccount m acc
 migratePersistentAccount m@StateMigrationParametersP2P3 (PAV0 acc) = PAV0 <$> V0.migratePersistentAccount m acc
 migratePersistentAccount m@StateMigrationParametersP3ToP4{} (PAV0 acc) = PAV1 <$> V0.migratePersistentAccount m acc
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationState.hs
new file mode 100644
index 000000000..746af9b8c
--- /dev/null
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationState.hs
@@ -0,0 +1,262 @@
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Concordium.GlobalState.Persistent.Account.MigrationState where
+
+import Control.Monad
+import Control.Monad.IO.Class
+import Control.Monad.State.Class
+import Control.Monad.Trans
+import Control.Monad.Trans.State.Strict
+import Data.Bool.Singletons
+import Data.Kind
+import Data.Maybe
+import Lens.Micro.Platform
+
+import Concordium.Types
+import Concordium.Types.Accounts
+import Concordium.Types.Conditionally
+import Concordium.Utils
+
+import qualified Concordium.GlobalState.AccountMap.LMDB as LMDBAccountMap
+import Concordium.GlobalState.Persistent.Account
+import Concordium.GlobalState.Persistent.Account.MigrationStateInterface
+import Concordium.GlobalState.Persistent.Accounts
+import Concordium.GlobalState.Persistent.Bakers as Bakers
+import Concordium.GlobalState.Persistent.BlobStore
+import Concordium.GlobalState.Persistent.Cache
+import Concordium.GlobalState.Persistent.Cooldown
+import qualified Concordium.GlobalState.Persistent.Trie as Trie
+
+-- | Whether the migration from one protocol version to another introduces flexible cooldown
+--  support.
+type IntroducesFlexibleCooldown (oldpv :: ProtocolVersion) (pv :: ProtocolVersion) =
+    Not (SupportsFlexibleCooldown (AccountVersionFor oldpv))
+        && SupportsFlexibleCooldown (AccountVersionFor pv)
+
+data AccountMigrationState (oldpv :: ProtocolVersion) (pv :: ProtocolVersion) = AccountMigrationState
+    { -- | In the P6 -> P7 protocol update, this records the accounts that previously were in
+      --  cooldown, and now will be in pre-pre-cooldown.
+      _migrationPrePreCooldown ::
+        !( Conditionally
+            (IntroducesFlexibleCooldown oldpv pv)
+            AccountList
+         ),
+      -- | When migrating P6->P7, we build up the 'PersistentActiveBakers' while
+      --  traversing the account table. This should be initialised with the active bakers (that
+      --  survive migration) but no delegators.
+      _persistentActiveBakers ::
+        !( Conditionally
+            (IntroducesFlexibleCooldown oldpv pv)
+            (PersistentActiveBakers (AccountVersionFor pv))
+         ),
+      -- | A counter to track the index of the current account as we traverse the account table.
+      _currentAccountIndex :: !AccountIndex
+    }
+makeLenses ''AccountMigrationState
+
+-- | Construct an initial 'PersistentActiveBakers' that records all of the bakers that are still
+-- active after migration, but does not include any delegators. This only applies when migrating
+-- to a protocol version that supports flexible cooldowns for the first time. The total active
+-- capital constitutes the stake of all bakers that remain active, with their capital reduced
+-- corresponding to any pending reduction in their stakes.
+--
+-- The idea is that with the P6->P7 migration, bakers that are in cooldown to be removed will
+-- actually be removed as bakers. During the processing of the account table, the delegators
+-- will be added back to the 'PersistentActiveBakers' as they are encountered.
+initialPersistentActiveBakersForMigration ::
+    forall oldpv av t m.
+    ( IsAccountVersion av,
+      SupportMigration m t,
+      SupportsPersistentAccount oldpv m
+    ) =>
+    Accounts oldpv ->
+    PersistentActiveBakers (AccountVersionFor oldpv) ->
+    t
+        m
+        ( Conditionally
+            (Not (SupportsFlexibleCooldown (AccountVersionFor oldpv)) && SupportsFlexibleCooldown av)
+            (PersistentActiveBakers av)
+        )
+initialPersistentActiveBakersForMigration oldAccounts oldActiveBakers = case (oldSFC, newSFC) of
+    (SFalse, SFalse) -> return CFalse
+    (STrue, _) -> return CFalse
+    (SFalse, STrue) -> do
+        bakers <- lift $ Trie.keysAsc (oldActiveBakers ^. activeBakers)
+        CTrue <$> foldM accumBakers emptyPersistentActiveBakers bakers
+      where
+        accumBakers :: PersistentActiveBakers av -> BakerId -> t m (PersistentActiveBakers av)
+        accumBakers pab bakerId =
+            lift (indexedAccount (bakerAccountIndex bakerId) oldAccounts) >>= \case
+                Nothing -> error "Baker account does not exist"
+                Just account -> do
+                    lift (accountBaker account) >>= \case
+                        Nothing -> error "Baker account is not a baker."
+                        Just bkr -> case _bakerPendingChange bkr of
+                            RemoveStake{} -> do
+                                -- The baker is pending removal, so it will be removed from
+                                -- the account in this update.
+                                return pab
+                            ReduceStake newStake _ -> do
+                                -- The baker's stake is reduced, so retain it with the new stake.
+                                retainBaker newStake
+                            NoChange -> do
+                                -- Retain the baker with the existing stake.
+                                retainBaker (bkr ^. stakedAmount)
+                          where
+                            retainBaker newStake = do
+                                -- The baker is still active, so add it to the persistent active
+                                -- bakers.
+                                newActiveBakers <- Trie.insert bakerId emptyPersistentActiveDelegators (pab ^. activeBakers)
+                                newAggregationKeys <- Trie.insert (bkr ^. bakerAggregationVerifyKey) () (pab ^. aggregationKeys)
+                                let newTotalActiveCapital = addActiveCapital newStake (pab ^. totalActiveCapital)
+                                return
+                                    pab
+                                        { _activeBakers = newActiveBakers,
+                                          _aggregationKeys = newAggregationKeys,
+                                          _totalActiveCapital = newTotalActiveCapital
+                                        }
+  where
+    oldSFC = sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor oldpv))
+    newSFC = sSupportsFlexibleCooldown (accountVersion @av)
+
+-- | An 'AccountMigrationState' in an initial state.
+initialAccountMigrationState ::
+    forall oldpv pv.
+    (IsProtocolVersion oldpv, IsProtocolVersion pv) =>
+    -- | The active bakers without the delegators.
+    Conditionally
+        (IntroducesFlexibleCooldown oldpv pv)
+        (PersistentActiveBakers (AccountVersionFor pv)) ->
+    AccountMigrationState oldpv pv
+initialAccountMigrationState _persistentActiveBakers = AccountMigrationState{..}
+  where
+    _migrationPrePreCooldown = case sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor oldpv)) of
+        SFalse -> case sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv)) of
+            SFalse -> CFalse
+            STrue -> CTrue Null
+        STrue -> CFalse
+    _currentAccountIndex = 0
+
+-- | Construct an initial account migration state that records all of the active bakers that
+--  remain active after the migration. This is then used
+makeInitialAccountMigrationState ::
+    ( IsProtocolVersion pv,
+      SupportMigration m t,
+      SupportsPersistentAccount oldpv m
+    ) =>
+    Accounts oldpv ->
+    PersistentActiveBakers (AccountVersionFor oldpv) ->
+    t m (AccountMigrationState oldpv pv)
+makeInitialAccountMigrationState accounts pab =
+    initialAccountMigrationState <$> initialPersistentActiveBakersForMigration accounts pab
+
+-- | A monad transformer transformer that left-composes @StateT (AccountMigrationState old pv)@
+--  with a given monad transformer @t@.
+newtype
+    AccountMigrationStateTT
+        (oldpv :: ProtocolVersion)
+        (pv :: ProtocolVersion)
+        (t :: (Type -> Type) -> (Type -> Type))
+        (m :: (Type -> Type))
+        (a :: Type) = AccountMigrationStateTT
+    { runAccountMigrationStateTT' ::
+        StateT (AccountMigrationState oldpv pv) (t m) a
+    }
+    deriving newtype
+        ( Functor,
+          Applicative,
+          Monad,
+          MonadState (AccountMigrationState oldpv pv),
+          MonadIO,
+          LMDBAccountMap.MonadAccountMapStore
+        )
+
+-- | Run an 'AccountMigrationStateTT' computation with the given initial state.
+--  This is used to add 'AccountMigration' and 'AccountsMigration' interfaces to the monad stack.
+runAccountMigrationStateTT ::
+    AccountMigrationStateTT oldpv pv t m a ->
+    AccountMigrationState oldpv pv ->
+    t m (a, AccountMigrationState oldpv pv)
+runAccountMigrationStateTT = runStateT . runAccountMigrationStateTT'
+
+deriving via
+    forall
+        (oldpv :: ProtocolVersion)
+        (pv :: ProtocolVersion)
+        (t :: (Type -> Type) -> (Type -> Type))
+        (m :: (Type -> Type)).
+    ( StateT (AccountMigrationState oldpv pv) (t m)
+    )
+    instance
+        (MonadBlobStore (t m)) =>
+        (MonadBlobStore (AccountMigrationStateTT oldpv pv t m))
+
+deriving via
+    forall
+        (oldpv :: ProtocolVersion)
+        (pv :: ProtocolVersion)
+        (t :: (Type -> Type) -> (Type -> Type))
+        (m :: (Type -> Type)).
+    ( StateT (AccountMigrationState oldpv pv) (t m)
+    )
+    instance
+        (MonadCache c (t m)) =>
+        (MonadCache c (AccountMigrationStateTT oldpv pv t m))
+
+instance (MonadTrans t) => MonadTrans (AccountMigrationStateTT oldpv pv t) where
+    lift = AccountMigrationStateTT . lift . lift
+
+instance
+    (MonadBlobStore (t m), IsProtocolVersion pv, av ~ AccountVersionFor pv) =>
+    AccountMigration av (AccountMigrationStateTT oldpv pv t m)
+    where
+    addAccountInPrePreCooldown = do
+        ai <- use currentAccountIndex
+        mmpc <- use migrationPrePreCooldown
+        case mmpc of
+            CTrue mpc -> do
+                newHead <-
+                    makeUnbufferedRef
+                        AccountListItem
+                            { accountListEntry = ai,
+                              accountListTail = mpc
+                            }
+                migrationPrePreCooldown .= CTrue (Some newHead)
+            CFalse -> return ()
+
+    isBakerRemoved bakerId =
+        use persistentActiveBakers >>= \case
+            CFalse -> return False
+            CTrue pab ->
+                isNothing <$> Trie.lookup bakerId (pab ^. activeBakers)
+
+    retainDelegator delId delAmt delTarget =
+        use persistentActiveBakers >>= \case
+            CTrue pab ->
+                Bakers.addDelegator delTarget delId delAmt pab >>= \case
+                    Left bid ->
+                        error $
+                            "Baker "
+                                ++ show bid
+                                ++ " (delegated to by "
+                                ++ show delId
+                                ++ ") is not a baker."
+                    Right newPAB -> do
+                        -- Note that addDelegator does not change the total active capital, so
+                        -- we do it here.
+                        persistentActiveBakers
+                            .= CTrue (newPAB & totalActiveCapital %~ addActiveCapital delAmt)
+            CFalse -> return ()
+
+instance
+    (MonadBlobStore (t m), IsProtocolVersion pv, av ~ AccountVersionFor pv) =>
+    AccountsMigration av (AccountMigrationStateTT oldpv pv t m)
+    where
+    nextAccount = currentAccountIndex %=! (+ 1)
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationStateInterface.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationStateInterface.hs
new file mode 100644
index 000000000..b5fa38b62
--- /dev/null
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationStateInterface.hs
@@ -0,0 +1,30 @@
+module Concordium.GlobalState.Persistent.Account.MigrationStateInterface where
+
+import Concordium.Types
+import Concordium.Types.Execution
+
+-- | This class provides functionality used during account migration. Much of this functionality
+--  is dependent on the protocol versions involved in the migration. This interface is used when
+--  migrating one particular account.
+class AccountMigration (av :: AccountVersion) m | m -> av where
+    -- | Add the current account to the set of accounts that should be considered in
+    --  pre-pre-cooldown as part of migration. This only has an effect when transitioning from a
+    --  protocol version that does not support flexible cooldown to one that does.
+    addAccountInPrePreCooldown :: m ()
+
+    -- | Query if the given 'BakerId' is set to be removed in this migration.
+    --  (The result is unspecified if the 'BakerId' was not a baker prior to migration.)
+    isBakerRemoved :: BakerId -> m Bool
+
+    -- | Record that a delegator is retained, delegating a specified amount to a delegation target.
+    --  The delegator must not already have been retained. This MUST be called for every delegator
+    --  that remains a delegator after migration when transitioning from a protocol version that
+    --  does not support flexible delegation to one that does. Outside of such a transition, this
+    --  has no effect.
+    retainDelegator :: (AVSupportsDelegation av) => DelegatorId -> Amount -> DelegationTarget -> m ()
+
+-- | This class provides functionality used during account migration. This interface is used when
+--  migrating the entire account table.
+class (AccountMigration av m) => AccountsMigration (av :: AccountVersion) m | m -> av where
+    -- | Progress to the next sequential account index.
+    nextAccount :: m ()
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
index dc3271fd4..a7dd4a4c1 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
@@ -17,6 +17,7 @@ module Concordium.GlobalState.Persistent.Account.StructureV1 where
 
 import Control.Monad
 import Control.Monad.Trans
+import qualified Control.Monad.Trans.State.Strict as State
 import Data.Bits
 import Data.Bool.Singletons
 import Data.Foldable
@@ -45,6 +46,7 @@ import Concordium.GlobalState.BlockState (AccountAllowance (..))
 import Concordium.GlobalState.CooldownQueue (Cooldowns (..))
 import Concordium.GlobalState.Persistent.Account.CooldownQueue as CooldownQueue
 import Concordium.GlobalState.Persistent.Account.EncryptedAmount
+import Concordium.GlobalState.Persistent.Account.MigrationStateInterface
 import qualified Concordium.GlobalState.Persistent.Account.StructureV0 as V0
 import Concordium.GlobalState.Persistent.BlobStore
 import qualified Concordium.GlobalState.Persistent.BlockState.AccountReleaseSchedule as ARSV0
@@ -204,6 +206,103 @@ migratePersistentAccountStakeEnduring PersistentAccountStakeEnduringBaker{..} =
 migratePersistentAccountStakeEnduring PersistentAccountStakeEnduringDelegator{..} =
     return $! PersistentAccountStakeEnduringDelegator{..}
 
+-- | Migrate a 'PersistentAccountStakeEnduring' from 'AccountV2' to 'AccountV3'.  This runs in the
+--   'StateT' monad, where the state is the amount of active stake on the account.
+--
+--   * If there is a pending change on the account, then the pending change is removed and the
+--     active stake is updated to apply the pending change. The change in the stake is moved to
+--     pre-pre-cooldown in the returned 'CooldownQueue'. 'addAccountInPrePreCooldown' is called
+--     to record that the account is in pre-pre-cooldown. If the pending change was a removal,
+--     the baker or delegator record is removed from the account.
+
+--   * If the account is (still) a delegator and the baker it was delegating to has been removed
+--     (according to 'isBakerRemoved'), then the delegator is changed to delegate to passive
+--     instead.
+--
+--   * If the account is (still) a delegator, then 'retainDelegator' is called to record the
+--     delegator's (updated) stake and target.
+migratePersistentAccountStakeEnduringV2toV3 ::
+    (SupportMigration m t, AccountMigration 'AccountV3 (t m)) =>
+    PersistentAccountStakeEnduring 'AccountV2 ->
+    -- | Returns the new 'PersistentAccountStakeEnduring' and 'CooldownQueue'.
+    State.StateT Amount (t m) (PersistentAccountStakeEnduring 'AccountV3, CooldownQueue 'AccountV3)
+migratePersistentAccountStakeEnduringV2toV3 PersistentAccountStakeEnduringNone =
+    return (PersistentAccountStakeEnduringNone, emptyCooldownQueue)
+migratePersistentAccountStakeEnduringV2toV3 PersistentAccountStakeEnduringBaker{..} =
+    case paseBakerPendingChange of
+        RemoveStake _ -> do
+            -- The baker is being removed, so we don't migrate it.
+            -- Get the old stake, updating it to 0.
+            cooldownAmount <- State.get
+            State.put 0
+            cooldown <- initialPrePreCooldownQueue cooldownAmount
+            lift addAccountInPrePreCooldown
+            return (PersistentAccountStakeEnduringNone, cooldown)
+        ReduceStake newStake _ -> do
+            oldStake <- State.get
+            unless (newStake <= oldStake) $
+                error $
+                    "Stake on baker 'reduced' from "
+                        ++ show oldStake
+                        ++ " to "
+                        ++ show newStake
+            State.put newStake
+            cooldown <- initialPrePreCooldownQueue (oldStake - newStake)
+            lift addAccountInPrePreCooldown
+            newPASE <- keepBakerInfo
+            return (newPASE, cooldown)
+        NoChange -> (,emptyCooldownQueue) <$> keepBakerInfo
+  where
+    keepBakerInfo = do
+        newBakerInfo <- migrateReference (return . coerceBakerInfoExV1) paseBakerInfo
+        return
+            PersistentAccountStakeEnduringBaker
+                { paseBakerInfo = newBakerInfo,
+                  paseBakerPendingChange = NoChange,
+                  ..
+                }
+migratePersistentAccountStakeEnduringV2toV3 PersistentAccountStakeEnduringDelegator{..} =
+    case paseDelegatorPendingChange of
+        RemoveStake _ -> do
+            -- Get the old stake, updating it to 0.
+            cooldownAmount <- State.get
+            State.put 0
+            cooldown <- initialPrePreCooldownQueue cooldownAmount
+            lift addAccountInPrePreCooldown
+            return (PersistentAccountStakeEnduringNone, cooldown)
+        _ -> do
+            newTarget <- case paseDelegatorTarget of
+                DelegatePassive -> return DelegatePassive
+                DelegateToBaker bid -> do
+                    removed <- lift $ isBakerRemoved bid
+                    return $ if removed then DelegatePassive else paseDelegatorTarget
+            let newDelegatorInfo =
+                    PersistentAccountStakeEnduringDelegator
+                        { paseDelegatorPendingChange = NoChange,
+                          paseDelegatorTarget = newTarget,
+                          ..
+                        }
+            oldStake <- State.get
+            case paseDelegatorPendingChange of
+                ReduceStake newStake _ -> do
+                    unless (newStake <= oldStake) $
+                        error $
+                            "Stake on delegator "
+                                ++ show paseDelegatorId
+                                ++ " 'reduced' from "
+                                ++ show oldStake
+                                ++ " to "
+                                ++ show newStake
+                    State.put newStake
+                    cooldown <- initialPrePreCooldownQueue (oldStake - newStake)
+                    lift $ do
+                        addAccountInPrePreCooldown
+                        retainDelegator paseDelegatorId newStake newTarget
+                    return $!! (newDelegatorInfo, cooldown)
+                NoChange -> do
+                    lift $ retainDelegator paseDelegatorId oldStake newTarget
+                    return $!! (newDelegatorInfo, emptyCooldownQueue)
+
 -- | This relies on the fact that the 'AccountV2' hashing of 'AccountStake' is independent of the
 --  staked amount.
 instance (MonadBlobStore m) => MHashableTo m (AccountStakeHash 'AccountV2) (PersistentAccountStakeEnduring 'AccountV2) where
@@ -1632,12 +1731,11 @@ makeFromGenesisAccount spv cryptoParams chainParameters GenesisAccount{..} = do
 
 -- ** Migration
 
--- | Migration for 'PersistentAccountEnduringData'. Only supports 'AccountV2'.
-migrateEnduringData ::
+migrateEnduringDataV2 ::
     (SupportMigration m t) =>
     PersistentAccountEnduringData 'AccountV2 ->
     t m (PersistentAccountEnduringData 'AccountV2)
-migrateEnduringData ed = do
+migrateEnduringDataV2 ed = do
     paedPersistingData <- migrateEagerBufferedRef return (paedPersistingData ed)
     paedEncryptedAmount <- forM (paedEncryptedAmount ed) $ migrateReference migratePersistentEncryptedAmount
     paedReleaseSchedule <- forM (paedReleaseSchedule ed) $ \(oldRSRef, lockedAmt) -> do
@@ -1651,10 +1749,57 @@ migrateEnduringData ed = do
               ..
             }
 
--- | A trivial migration from account version 2 to
---  account version 2.
---  In particular this function only migrates the underlying reference to
---  the 'PersistentAccountEnduringData'.
+-- | Migrate enduring data from 'AccountV2' to 'AccountV3'. The 'Amount' in the 'State.StateT'
+--  represents the current active stake on the account.
+--
+--   * If the account previously had a pending change, it will now have a pre-pre-cooldown, and
+--     'addAccountInPrePreCooldown' is called (to register this globally). If the pending change
+--     was a reduction in stake, the reduction is applied immediately to the active stake. If the
+--     pending change wass a removal, the baker or delegator record is removed altogether.
+--
+--   * If the account is still delegating but was delegating to a baker for which 'isBakerRemoved'
+--     returns @True@, the delegation target is updated to passive delegation.
+--
+--   * If the account is still delegating, 'retainDelegator' is called to record the (new)
+--     delegation amount and target globally.
+migrateEnduringDataV2toV3 ::
+    (SupportMigration m t, AccountMigration 'AccountV3 (t m)) =>
+    -- | Current enduring data
+    PersistentAccountEnduringData 'AccountV2 ->
+    -- | New enduring data.
+    State.StateT Amount (t m) (PersistentAccountEnduringData 'AccountV3)
+migrateEnduringDataV2toV3 ed = do
+    paedPersistingData <- migrateEagerBufferedRef return (paedPersistingData ed)
+    paedEncryptedAmount <- forM (paedEncryptedAmount ed) $ migrateReference migratePersistentEncryptedAmount
+    paedReleaseSchedule <- forM (paedReleaseSchedule ed) $ \(oldRSRef, lockedAmt) -> do
+        newRSRef <- migrateReference migrateAccountReleaseSchedule oldRSRef
+        return (newRSRef, lockedAmt)
+    (paedStake, paedStakeCooldown) <- migratePersistentAccountStakeEnduringV2toV3 (paedStake ed)
+    makeAccountEnduringDataAV3
+        paedPersistingData
+        paedEncryptedAmount
+        paedReleaseSchedule
+        paedStake
+        paedStakeCooldown
+
+-- | Migration for 'PersistentAccountEnduringData'. Only supports 'AccountV3'.
+--  The data is unchanged in the migration.
+migrateEnduringDataV3toV3 ::
+    (SupportMigration m t) =>
+    PersistentAccountEnduringData 'AccountV3 ->
+    t m (PersistentAccountEnduringData 'AccountV3)
+migrateEnduringDataV3toV3 ed = do
+    paedPersistingData <- migrateEagerBufferedRef return (paedPersistingData ed)
+    paedEncryptedAmount <- forM (paedEncryptedAmount ed) $ migrateReference migratePersistentEncryptedAmount
+    paedReleaseSchedule <- forM (paedReleaseSchedule ed) $ \(oldRSRef, lockedAmt) -> do
+        newRSRef <- migrateReference migrateAccountReleaseSchedule oldRSRef
+        return (newRSRef, lockedAmt)
+    paedStake <- migratePersistentAccountStakeEnduring (paedStake ed)
+    paedStakeCooldown <- migrateCooldownQueue (paedStakeCooldown ed)
+    makeAccountEnduringDataAV3 paedPersistingData paedEncryptedAmount paedReleaseSchedule paedStake paedStakeCooldown
+
+-- | A trivial migration from account version 2 to account version 2.
+--  In particular the data is retained as-is.
 migrateV2ToV2 ::
     ( MonadBlobStore m,
       MonadBlobStore (t m),
@@ -1663,7 +1808,63 @@ migrateV2ToV2 ::
     PersistentAccount 'AccountV2 ->
     t m (PersistentAccount 'AccountV2)
 migrateV2ToV2 acc = do
-    accountEnduringData <- migrateEagerBufferedRef migrateEnduringData (accountEnduringData acc)
+    accountEnduringData <- migrateEagerBufferedRef migrateEnduringDataV2 (accountEnduringData acc)
+    return $!
+        PersistentAccount
+            { accountNonce = accountNonce acc,
+              accountAmount = accountAmount acc,
+              accountStakedAmount = accountStakedAmount acc,
+              ..
+            }
+
+-- | Migrate from account version 2 to account version 3.
+--
+--   * If the account previously had a pending change, it will now have a pre-pre-cooldown, and
+--     'addAccountInPrePreCooldown' is called (to register this globally). If the pending change
+--     was a reduction in stake, the reduction is applied immediately to the active stake. If the
+--     pending change wass a removal, the baker or delegator record is removed altogether.
+--
+--   * If the account is still delegating but was delegating to a baker for which 'isBakerRemoved'
+--     returns @True@, the delegation target is updated to passive delegation.
+--
+--   * If the account is still delegating, 'retainDelegator' is called to record the (new)
+--     delegation amount and target globally.
+--
+--  Note: the global record of which bakers are retained and their stakes is determined a priori
+--  (see "Concordium.GlobalState.Persistent.Account.MigrationState"). This is used to determine
+--  whether a baker is removed.
+migrateV2ToV3 ::
+    ( MonadBlobStore m,
+      MonadBlobStore (t m),
+      AccountMigration 'AccountV3 (t m),
+      MonadTrans t
+    ) =>
+    PersistentAccount 'AccountV2 ->
+    t m (PersistentAccount 'AccountV3)
+migrateV2ToV3 acc = do
+    (accountEnduringData, newStakedAmount) <-
+        State.runStateT
+            (migrateEagerBufferedRef migrateEnduringDataV2toV3 (accountEnduringData acc))
+            (accountStakedAmount acc)
+    return $!
+        PersistentAccount
+            { accountNonce = accountNonce acc,
+              accountAmount = accountAmount acc,
+              accountStakedAmount = newStakedAmount,
+              ..
+            }
+
+-- | A trivial migration from account version 3 to account version 3.
+--  In particular the data is retained as-is.
+migrateV3ToV3 ::
+    ( MonadBlobStore m,
+      MonadBlobStore (t m),
+      MonadTrans t
+    ) =>
+    PersistentAccount 'AccountV3 ->
+    t m (PersistentAccount 'AccountV3)
+migrateV3ToV3 acc = do
+    accountEnduringData <- migrateEagerBufferedRef migrateEnduringDataV3toV3 (accountEnduringData acc)
     return $!
         PersistentAccount
             { accountNonce = accountNonce acc,
@@ -1672,17 +1873,36 @@ migrateV2ToV2 acc = do
               ..
             }
 
--- | Migration for 'PersistentAccount'. Only supports 'AccountV2'.
+-- | Migration for 'PersistentAccount'. Supports 'AccountV2' and 'AccountV3'.
+--
+--  When migrating P6->P7 (account version 2 to 3), the 'AccountMigration' interface is used as
+--  follows:
+--
+--   * Accounts that previously had a pending change are updated to have a pre-pre-cooldown, and
+--     'addAccountInPrePreCooldown' is called. If the pending change is a reduction in stake,
+--     the reduction is applied immediately to the active stake. If the pending change is a removal,
+--     the baker or delegator record is removed altogether.
+--
+--   * Accounts that are still delegating but were delegating to a baker for which 'isBakerRemoved'
+--     returns @True@ are updated to delegate to passive delegation.
+--
+--   * For accounts that are still delegating, 'retainDelegator' is called to record the (new)
+--     delegation amount and target.
 migratePersistentAccount ::
-    ( SupportMigration m t,
-      AccountVersionFor oldpv ~ 'AccountV2
+    forall m t oldpv pv.
+    ( IsProtocolVersion oldpv,
+      SupportMigration m t,
+      AccountMigration (AccountVersionFor pv) (t m),
+      AccountStructureVersionFor (AccountVersionFor oldpv) ~ 'AccountStructureV1
     ) =>
     StateMigrationParameters oldpv pv ->
     PersistentAccount (AccountVersionFor oldpv) ->
     t m (PersistentAccount (AccountVersionFor pv))
-migratePersistentAccount StateMigrationParametersTrivial acc = migrateV2ToV2 acc
+migratePersistentAccount StateMigrationParametersTrivial acc = case accountVersion @(AccountVersionFor oldpv) of
+    SAccountV2 -> migrateV2ToV2 acc
+    SAccountV3 -> migrateV3ToV3 acc
 migratePersistentAccount StateMigrationParametersP5ToP6{} acc = migrateV2ToV2 acc
-migratePersistentAccount StateMigrationParametersP6ToP7{} _ = undefined -- TODO: implement migration
+migratePersistentAccount StateMigrationParametersP6ToP7{} acc = migrateV2ToV3 acc
 
 -- | Migration for 'PersistentAccount' from 'V0.PersistentAccount'. This supports migration from
 --  'P4' to 'P5'.
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs
index 4a98b21c7..e737faafe 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs
@@ -67,6 +67,7 @@ import qualified Concordium.GlobalState.AccountMap.LMDB as LMDBAccountMap
 import Concordium.GlobalState.BlockState (AccountsHash (..))
 import Concordium.GlobalState.Parameters
 import Concordium.GlobalState.Persistent.Account
+import Concordium.GlobalState.Persistent.Account.MigrationStateInterface
 import Concordium.GlobalState.Persistent.BlobStore
 import Concordium.GlobalState.Persistent.Cache
 import Concordium.GlobalState.Persistent.CachedRef
@@ -311,7 +312,7 @@ getAccountByCredId cid accs@Accounts{..} =
 --  First try lookup in the in-memory difference map associated with the the provided 'Accounts pv',
 --  if no account could be looked up, then we fall back to the lmdb backed account map.
 --
--- If account alises are supported then the equivalence class 'AccountAddressEq' is used for determining
+-- If account aliases are supported then the equivalence class 'AccountAddressEq' is used for determining
 -- whether the provided @AccountAddress@ is in the map, otherwise we check for exactness.
 getAccountIndex :: forall pv m. (SupportsPersistentAccount pv m) => AccountAddress -> Accounts pv -> m (Maybe AccountIndex)
 getAccountIndex addr Accounts{..} = do
@@ -419,6 +420,14 @@ updateAccountsAtIndex fupd ai a0@Accounts{..} =
         Nothing -> return (Nothing, a0)
         Just (res, act') -> return (Just res, a0{accountTable = act'})
 
+-- | Set the account at the given index. There must already be an account at the given index
+--  (otherwise this has no effect).
+setAccountAtIndex :: (SupportsPersistentAccount pv m) => AccountIndex -> PersistentAccount (AccountVersionFor pv) -> Accounts pv -> m (Accounts pv)
+setAccountAtIndex ai newAcct a0@Accounts{..} =
+    L.update (const (return ((), newAcct))) ai accountTable >>= \case
+        Nothing -> return a0
+        Just (_, act') -> return (a0{accountTable = act'})
+
 -- | Perform an update to an account with the given index.
 --  Does nothing if the account does not exist.
 --  This should not be used to alter the address of an account (which is
@@ -490,13 +499,23 @@ migrateAccounts ::
       IsProtocolVersion pv,
       SupportMigration m t,
       SupportsPersistentAccount oldpv m,
-      SupportsPersistentAccount pv (t m)
+      SupportsPersistentAccount pv (t m),
+      AccountsMigration (AccountVersionFor pv) (t m)
     ) =>
     StateMigrationParameters oldpv pv ->
     Accounts oldpv ->
     t m (Accounts pv)
 migrateAccounts migration Accounts{..} = do
-    newAccountTable <- L.migrateLFMBTree (migrateHashedCachedRef' (migratePersistentAccount migration)) accountTable
+    let migrateAccount acct = do
+            newAcct <- migrateHashedCachedRef' (migratePersistentAccount migration) acct
+            -- Increment the account index counter.
+            nextAccount
+            return newAcct
+    newAccountTable <-
+        L.migrateLFMBTree
+            migrateAccount
+            accountTable
+
     -- The account registration IDs are not cached. There is a separate cache
     -- that is purely in-memory and just copied over.
     newAccountRegIds <- Trie.migrateUnbufferedTrieN return accountRegIdHistory
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Bakers.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Bakers.hs
index 52a82fc70..ee433759f 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Bakers.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Bakers.hs
@@ -437,6 +437,24 @@ migratePersistentActiveBakers migration accounts PersistentActiveBakers{..} = do
               _totalActiveCapital = newTotalActiveCapital
             }
 
+-- | Construct a 'PersistentActiveBakers' with no bakers or delegators.
+emptyPersistentActiveBakers :: forall av. (IsAccountVersion av) => PersistentActiveBakers av
+emptyPersistentActiveBakers = case delegationSupport @av of
+    SAVDelegationSupported ->
+        PersistentActiveBakers
+            { _activeBakers = Trie.empty,
+              _aggregationKeys = Trie.empty,
+              _passiveDelegators = PersistentActiveDelegatorsV1 Trie.empty 0,
+              _totalActiveCapital = TotalActiveCapitalV1 0
+            }
+    SAVDelegationNotSupported ->
+        PersistentActiveBakers
+            { _activeBakers = Trie.empty,
+              _aggregationKeys = Trie.empty,
+              _passiveDelegators = PersistentActiveDelegatorsV0,
+              _totalActiveCapital = TotalActiveCapitalV0
+            }
+
 totalActiveCapitalV1 :: (AVSupportsDelegation av) => Lens' (PersistentActiveBakers av) Amount
 totalActiveCapitalV1 = totalActiveCapital . tac
   where
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
index da95c6f80..c5b2a581d 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
@@ -49,6 +49,7 @@ import Concordium.GlobalState.CapitalDistribution
 import qualified Concordium.GlobalState.ContractStateV1 as StateV1
 import Concordium.GlobalState.Parameters
 import Concordium.GlobalState.Persistent.Account
+import qualified Concordium.GlobalState.Persistent.Account.MigrationState as MigrationState
 import Concordium.GlobalState.Persistent.Accounts (SupportsPersistentAccount)
 import qualified Concordium.GlobalState.Persistent.Accounts as Accounts
 import qualified Concordium.GlobalState.Persistent.Accounts as LMDBAccountMap
@@ -57,6 +58,7 @@ import Concordium.GlobalState.Persistent.BlobStore
 import qualified Concordium.GlobalState.Persistent.BlockState.Modules as Modules
 import Concordium.GlobalState.Persistent.BlockState.Updates
 import qualified Concordium.GlobalState.Persistent.Cache as Cache
+import Concordium.GlobalState.Persistent.Cooldown
 import Concordium.GlobalState.Persistent.Instances (PersistentInstance (..), PersistentInstanceParameters (..), PersistentInstanceV (..))
 import qualified Concordium.GlobalState.Persistent.Instances as Instances
 import qualified Concordium.GlobalState.Persistent.LFMBTree as LFMBT
@@ -197,7 +199,7 @@ migrateSeedStateV1Trivial SeedStateV1{..} =
 --
 --  Migrate the birk parameters assuming accounts have already been migrated.
 migratePersistentBirkParameters ::
-    forall oldpv pv t m.
+    forall c oldpv pv t m.
     ( IsProtocolVersion pv,
       IsProtocolVersion oldpv,
       SupportMigration m t,
@@ -205,10 +207,13 @@ migratePersistentBirkParameters ::
     ) =>
     StateMigrationParameters oldpv pv ->
     Accounts.Accounts pv ->
+    Conditionally c (PersistentActiveBakers (AccountVersionFor pv)) ->
     PersistentBirkParameters oldpv ->
     t m (PersistentBirkParameters pv)
-migratePersistentBirkParameters migration accounts PersistentBirkParameters{..} = do
-    newActiveBakers <- migrateReference (migratePersistentActiveBakers migration accounts) _birkActiveBakers
+migratePersistentBirkParameters migration accounts mActiveBakers PersistentBirkParameters{..} = do
+    newActiveBakers <- case mActiveBakers of
+        CTrue ab -> refMake ab
+        CFalse -> migrateReference (migratePersistentActiveBakers migration accounts) _birkActiveBakers
     newNextEpochBakers <- migrateHashedBufferedRef (migratePersistentEpochBakers migration) _birkNextEpochBakers
     newCurrentEpochBakers <- migrateHashedBufferedRef (migratePersistentEpochBakers migration) _birkCurrentEpochBakers
     return
@@ -777,6 +782,7 @@ data BlockStatePointers (pv :: ProtocolVersion) = BlockStatePointers
       bspCryptographicParameters :: !(HashedBufferedRef CryptographicParameters),
       bspUpdates :: !(BufferedRef (Updates pv)),
       bspReleaseSchedule :: !(ReleaseSchedule pv),
+      bspAccountsInCooldown :: !(AccountsInCooldownForPV pv),
       bspTransactionOutcomes :: !(PersistentTransactionOutcomes (TransactionOutcomesVersionFor pv)),
       -- | Details of bakers that baked blocks in the current epoch. This is
       --  used for rewarding bakers at the end of epochs.
@@ -837,6 +843,7 @@ instance (SupportsPersistentState pv m) => BlobStorable m (BlockStatePointers pv
         (poutcomes, bspTransactionOutcomes') <- storeUpdate bspTransactionOutcomes
         (pupdates, bspUpdates') <- storeUpdate bspUpdates
         (preleases, bspReleaseSchedule') <- storeUpdate bspReleaseSchedule
+        (pAccountsInCooldown, bspAccountInCooldown') <- storeUpdate bspAccountsInCooldown
         (pRewardDetails, bspRewardDetails') <- storeUpdate bspRewardDetails
         let putBSP = do
                 paccts
@@ -850,6 +857,7 @@ instance (SupportsPersistentState pv m) => BlobStorable m (BlockStatePointers pv
                 poutcomes
                 pupdates
                 preleases
+                pAccountsInCooldown
                 pRewardDetails
         return
             ( putBSP,
@@ -864,6 +872,7 @@ instance (SupportsPersistentState pv m) => BlobStorable m (BlockStatePointers pv
                   bspTransactionOutcomes = bspTransactionOutcomes',
                   bspUpdates = bspUpdates',
                   bspReleaseSchedule = bspReleaseSchedule',
+                  bspAccountsInCooldown = bspAccountInCooldown',
                   bspRewardDetails = bspRewardDetails'
                 }
             )
@@ -879,6 +888,7 @@ instance (SupportsPersistentState pv m) => BlobStorable m (BlockStatePointers pv
         moutcomes <- label "Transaction outcomes" load
         mUpdates <- label "Updates" load
         mReleases <- label "Release schedule" load
+        mAccountsInCooldown <- label "Accounts in cooldown" load
         mRewardDetails <- label "Epoch blocks" load
         return $! do
             bspAccounts <- maccts
@@ -891,6 +901,7 @@ instance (SupportsPersistentState pv m) => BlobStorable m (BlockStatePointers pv
             bspTransactionOutcomes <- moutcomes
             bspUpdates <- mUpdates
             bspReleaseSchedule <- mReleases
+            bspAccountsInCooldown <- mAccountsInCooldown
             bspRewardDetails <- mRewardDetails
             return $! BlockStatePointers{..}
 
@@ -903,6 +914,7 @@ bspPoolRewards bsp = case bspRewardDetails bsp of
     BlockRewardDetailsV1 pr -> pr
 
 -- | An initial 'HashedPersistentBlockState', which may be used for testing purposes.
+-- This assumes that among the initial accounts, none are in (pre)*cooldown.
 {-# WARNING initialPersistentState "should only be used for testing" #-}
 initialPersistentState ::
     forall pv m.
@@ -925,6 +937,7 @@ initialPersistentState seedState cryptoParams accounts ips ars keysCollection ch
     initialAmount <- foldM (\sumSoFar account -> (+ sumSoFar) <$> accountAmount account) 0 accounts
     updates <- refMake =<< initialUpdates keysCollection chainParams
     releaseSchedule <- emptyReleaseSchedule
+    acctsInCooldown <- initialAccountsInCooldown accounts
     red <- emptyBlockRewardDetails
     bsp <-
         makeBufferedRef $
@@ -940,6 +953,7 @@ initialPersistentState seedState cryptoParams accounts ips ars keysCollection ch
                   bspTransactionOutcomes = emptyPersistentTransactionOutcomes,
                   bspUpdates = updates,
                   bspReleaseSchedule = releaseSchedule,
+                  bspAccountsInCooldown = acctsInCooldown,
                   bspRewardDetails = red
                 }
     bps <- liftIO $ newIORef $! bsp
@@ -975,6 +989,7 @@ emptyBlockState bspBirkParameters cryptParams keysCollection chainParams = do
                   bspIdentityProviders = identityProviders,
                   bspAnonymityRevokers = anonymityRevokers,
                   bspCryptographicParameters = cryptographicParameters,
+                  bspAccountsInCooldown = emptyAccountsInCooldownForPV,
                   bspTransactionOutcomes = emptyTransactionOutcomes (Proxy @pv),
                   ..
                 }
@@ -2002,7 +2017,9 @@ doUpdateBakerStake pbs ai newStake = do
                 do
                     let curEpoch = bspBirkParameters bsp ^. birkSeedState . epoch
                     upds <- refLoad (bspUpdates bsp)
-                    cooldown <- (2 +) . _cpBakerExtraCooldownEpochs . _cpCooldownParameters . unStoreSerialized <$> refLoad (currentParameters upds)
+                    cooldownEpochs <-
+                        (2 +) . _cpBakerExtraCooldownEpochs . _cpCooldownParameters . unStoreSerialized
+                            <$> refLoad (currentParameters upds)
 
                     bakerStakeThreshold <- (^. cpPoolParameters . ppBakerStakeThreshold) <$> doGetChainParameters pbs
                     let applyUpdate updAcc = do
@@ -2013,10 +2030,10 @@ doUpdateBakerStake pbs ai newStake = do
                             if newStake < bakerStakeThreshold
                                 then return (BSUStakeUnderThreshold, pbs)
                                 else
-                                    (BSUStakeReduced (BakerId ai) (curEpoch + cooldown),)
+                                    (BSUStakeReduced (BakerId ai) (curEpoch + cooldownEpochs),)
                                         <$> applyUpdate
                                             ( setAccountStakePendingChange
-                                                (BaseAccounts.ReduceStake newStake (BaseAccounts.PendingChangeEffectiveV0 $ curEpoch + cooldown))
+                                                (BaseAccounts.ReduceStake newStake (BaseAccounts.PendingChangeEffectiveV0 $ curEpoch + cooldownEpochs))
                                             )
                         EQ -> return (BSUStakeUnchanged (BakerId ai), pbs)
                         GT -> (BSUStakeIncreased (BakerId ai),) <$> applyUpdate (setAccountStake newStake)
@@ -2059,12 +2076,17 @@ doRemoveBaker pbs ai = do
                     -- transition.
                     let curEpoch = bspBirkParameters bsp ^. birkSeedState . epoch
                     upds <- refLoad (bspUpdates bsp)
-                    cooldown <- (2 +) . _cpBakerExtraCooldownEpochs . _cpCooldownParameters . unStoreSerialized <$> refLoad (currentParameters upds)
+                    cooldownEpochs <-
+                        (2 +) . _cpBakerExtraCooldownEpochs . _cpCooldownParameters . unStoreSerialized
+                            <$> refLoad (currentParameters upds)
                     let updAcc =
                             setAccountStakePendingChange $
-                                BaseAccounts.RemoveStake (BaseAccounts.PendingChangeEffectiveV0 $ curEpoch + cooldown)
+                                BaseAccounts.RemoveStake $
+                                    BaseAccounts.PendingChangeEffectiveV0 $
+                                        curEpoch + cooldownEpochs
                     newAccounts <- Accounts.updateAccountsAtIndex' updAcc ai (bspAccounts bsp)
-                    (BRRemoved (BakerId ai) (curEpoch + cooldown),) <$> storePBS pbs bsp{bspAccounts = newAccounts}
+                    (BRRemoved (BakerId ai) (curEpoch + cooldownEpochs),)
+                        <$> storePBS pbs bsp{bspAccounts = newAccounts}
         -- The account is not valid or has no baker
         _ -> return (BRInvalidBaker, pbs)
 
@@ -3742,7 +3764,18 @@ migrateBlockPointers migration BlockStatePointers{..} = do
             StateMigrationParametersP5ToP6{} -> RSMNewToNew
             StateMigrationParametersP6ToP7{} -> RSMNewToNew
     newReleaseSchedule <- migrateReleaseSchedule rsMigration bspReleaseSchedule
-    newAccounts <- Accounts.migrateAccounts migration bspAccounts
+    pab <- lift . refLoad $ bspBirkParameters ^. birkActiveBakers
+    -- When we migrate the accounts, we accumulate state
+    initMigrationState :: MigrationState.AccountMigrationState oldpv pv <-
+        MigrationState.makeInitialAccountMigrationState bspAccounts pab
+    (newAccounts, migrationState) <-
+        MigrationState.runAccountMigrationStateTT
+            (Accounts.migrateAccounts migration bspAccounts)
+            initMigrationState
+    newAccountsInCooldown <-
+        migrateAccountsInCooldownForPV
+            (MigrationState._migrationPrePreCooldown migrationState)
+            bspAccountsInCooldown
     newModules <- migrateHashedBufferedRef (Modules.migrateModules migration) bspModules
     modules <- refLoad newModules
     newInstances <- Instances.migrateInstances modules bspInstances
@@ -3750,7 +3783,12 @@ migrateBlockPointers migration BlockStatePointers{..} = do
     newIdentityProviders <- migrateHashedBufferedRefKeepHash bspIdentityProviders
     newAnonymityRevokers <- migrateHashedBufferedRefKeepHash bspAnonymityRevokers
     let oldEpoch = bspBirkParameters ^. birkSeedState . epoch
-    newBirkParameters <- migratePersistentBirkParameters migration newAccounts bspBirkParameters
+    newBirkParameters <-
+        migratePersistentBirkParameters
+            migration
+            newAccounts
+            (MigrationState._persistentActiveBakers migrationState)
+            bspBirkParameters
     newCryptographicParameters <- migrateHashedBufferedRefKeepHash bspCryptographicParameters
     newUpdates <- migrateReference (migrateUpdates migration) bspUpdates
     curBakers <- extractBakerStakes =<< refLoad (_birkCurrentEpochBakers newBirkParameters)
@@ -3774,6 +3812,7 @@ migrateBlockPointers migration BlockStatePointers{..} = do
               bspCryptographicParameters = newCryptographicParameters,
               bspUpdates = newUpdates,
               bspReleaseSchedule = newReleaseSchedule,
+              bspAccountsInCooldown = newAccountsInCooldown,
               bspTransactionOutcomes = newTransactionOutcomes,
               bspRewardDetails = newRewardDetails
             }
@@ -3816,6 +3855,7 @@ cacheState hpbs = do
     cryptoParams <- cache bspCryptographicParameters
     upds <- cache bspUpdates
     rels <- cache bspReleaseSchedule
+    cdowns <- cache bspAccountsInCooldown
     red <- cache bspRewardDetails
     _ <-
         storePBS (hpbsPointers hpbs) $!
@@ -3830,6 +3870,7 @@ cacheState hpbs = do
                   bspCryptographicParameters = cryptoParams,
                   bspUpdates = upds,
                   bspReleaseSchedule = rels,
+                  bspAccountsInCooldown = cdowns,
                   bspTransactionOutcomes = bspTransactionOutcomes,
                   bspRewardDetails = red
                 }
@@ -3864,11 +3905,13 @@ cacheStateAndGetTransactionTable hpbs = do
                 then
                     return $!
                         tt
-                            & TransactionTable.ttNonFinalizedChainUpdates . at' uty
+                            & TransactionTable.ttNonFinalizedChainUpdates
+                                . at' uty
                                 ?~ TransactionTable.emptyNFCUWithSequenceNumber sn
                 else return tt
     tt <- foldM updInTT TransactionTable.emptyTransactionTable [minBound ..]
     rels <- cache bspReleaseSchedule
+    cdowns <- cache bspAccountsInCooldown
     red <- cache bspRewardDetails
     _ <-
         storePBS
@@ -3884,6 +3927,7 @@ cacheStateAndGetTransactionTable hpbs = do
                   bspCryptographicParameters = cryptoParams,
                   bspUpdates = upds,
                   bspReleaseSchedule = rels,
+                  bspAccountsInCooldown = cdowns,
                   bspTransactionOutcomes = bspTransactionOutcomes,
                   bspRewardDetails = red
                 }
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Cooldown.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Cooldown.hs
new file mode 100644
index 000000000..2c0bd15bb
--- /dev/null
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Cooldown.hs
@@ -0,0 +1,251 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Concordium.GlobalState.Persistent.Cooldown where
+
+import Control.Monad
+import Data.Bool.Singletons
+import qualified Data.Map.Strict as Map
+import Data.Serialize
+import Lens.Micro.Platform
+
+import qualified Concordium.GlobalState.CooldownQueue as CooldownQueue
+import Concordium.GlobalState.Persistent.Account
+import Concordium.GlobalState.Persistent.BlobStore
+import Concordium.GlobalState.Persistent.ReleaseSchedule
+import Concordium.Types
+import Concordium.Types.Conditionally
+import Concordium.Types.Option
+
+-- | An 'AccountIndex' and the (possibly empty) tail of the list.
+data AccountListItem = AccountListItem
+    { accountListEntry :: !AccountIndex,
+      accountListTail :: !AccountList
+    }
+
+instance (MonadBlobStore m) => BlobStorable m AccountListItem where
+    load = do
+        mAccountListEntry <- load
+        mAccountListTail <- load
+        return (AccountListItem <$> mAccountListEntry <*> mAccountListTail)
+    storeUpdate ali = do
+        (pAccountListTail, newAccountListTail) <- storeUpdate (accountListTail ali)
+        return
+            ( put (accountListEntry ali) >> pAccountListTail,
+              ali{accountListTail = newAccountListTail}
+            )
+
+-- | A possibly empty list of 'AccountIndex'es, stored under 'UnbufferedRef's.
+type AccountList = Nullable (UnbufferedRef AccountListItem)
+
+-- | Prepend an 'AccountIndex' to an 'AccountList'.
+consAccountList :: (MonadBlobStore m) => AccountIndex -> AccountList -> m AccountList
+consAccountList accountIndex accountList = do
+    ref <- refMake (AccountListItem accountIndex accountList)
+    return (Some ref)
+
+-- | Load an entire account list. This is intended for testing purposes.
+loadAccountList :: (MonadBlobStore m) => AccountList -> m [AccountIndex]
+loadAccountList Null = return []
+loadAccountList (Some ref) = do
+    AccountListItem{..} <- refLoad ref
+    (accountListEntry :) <$> loadAccountList accountListTail
+
+-- | Migrate an 'AccountList' from one context to another.
+migrateAccountList :: (SupportMigration m t) => AccountList -> t m AccountList
+migrateAccountList Null = return Null
+migrateAccountList (Some ubRef) = do
+    Some <$> migrateReference migrateAccountListItem ubRef
+  where
+    migrateAccountListItem ali = do
+        newTail <- migrateAccountList (accountListTail ali)
+        return $! ali{accountListTail = newTail}
+
+removeAccountFromAccountListItem :: (MonadBlobStore m) => AccountIndex -> AccountListItem -> m AccountList
+removeAccountFromAccountListItem ai alist =
+    if accountListEntry alist == ai
+        then return $ accountListTail alist
+        else case accountListTail alist of
+            Null -> Some <$> refMake alist
+            Some ref -> do
+                alistItem <- refLoad ref
+                newList <- removeAccountFromAccountListItem ai alistItem
+                newRef <- refMake $ AccountListItem (accountListEntry alist) newList
+                return $ Some newRef
+
+removeAccountFromAccountList :: (MonadBlobStore m) => AccountIndex -> AccountList -> m AccountList
+removeAccountFromAccountList ai alist = case alist of
+    Null -> return Null
+    Some ref -> do
+        item <- refLoad ref
+        removeAccountFromAccountListItem ai item
+
+-- | This is an indexing structure and therefore does not need to be hashed. FIXME: add more docs
+data AccountsInCooldown = AccountsInCooldown
+    { -- | The accounts that are in cooldown with their earliest release times.
+      _cooldown :: !NewReleaseSchedule,
+      -- | The accounts that are in pre-cooldown.
+      _preCooldown :: !AccountList,
+      -- | The accounts that are in pre-pre-cooldown.
+      _prePreCooldown :: !AccountList
+    }
+
+makeLenses ''AccountsInCooldown
+
+-- | The cacheable instance only caches the 'cooldown' field, since the
+--  'preCooldown' and 'prePreCooldown' are implemented using 'UnbufferedRef's (and so
+--  would have no benefit from caching).
+instance (MonadBlobStore m) => Cacheable m AccountsInCooldown where
+    cache = cooldown cache
+
+instance (MonadBlobStore m) => BlobStorable m AccountsInCooldown where
+    load = do
+        mCooldown <- load
+        mPreCooldown <- load
+        mPrePreCooldown <- load
+        return (AccountsInCooldown <$> mCooldown <*> mPreCooldown <*> mPrePreCooldown)
+    storeUpdate aic = do
+        (pCooldown, newCooldown) <- storeUpdate (_cooldown aic)
+        (pPreCooldown, newPreCooldown) <- storeUpdate (_preCooldown aic)
+        (pPrePreCooldown, newPrePreCooldown) <- storeUpdate (_prePreCooldown aic)
+        let putAIC = pCooldown >> pPreCooldown >> pPrePreCooldown
+        return
+            ( putAIC,
+              AccountsInCooldown
+                { _cooldown = newCooldown,
+                  _preCooldown = newPreCooldown,
+                  _prePreCooldown = newPrePreCooldown
+                }
+            )
+
+-- | An 'AccountsInCooldown' with no accounts in (pre)*cooldown.
+emptyAccountsInCooldown :: AccountsInCooldown
+emptyAccountsInCooldown =
+    AccountsInCooldown
+        { _cooldown = emptyNewReleaseSchedule,
+          _preCooldown = Null,
+          _prePreCooldown = Null
+        }
+
+-- | Migrate 'AccountsInCooldown' from one 'BlobStore' to another.
+migrateAccountsInCooldown ::
+    (SupportMigration m t) =>
+    AccountsInCooldown ->
+    t m AccountsInCooldown
+migrateAccountsInCooldown aic = do
+    newCooldown <- migrateNewReleaseSchedule (_cooldown aic)
+    newPreCooldown <- migrateAccountList (_preCooldown aic)
+    newPrePreCooldown <- migrateAccountList (_prePreCooldown aic)
+    return $!
+        AccountsInCooldown
+            { _cooldown = newCooldown,
+              _preCooldown = newPreCooldown,
+              _prePreCooldown = newPrePreCooldown
+            }
+
+newtype AccountsInCooldownForPV pv = AccountsInCooldownForPV
+    { theAccountsInCooldownForPV ::
+        Conditionally (SupportsFlexibleCooldown (AccountVersionFor pv)) AccountsInCooldown
+    }
+
+instance (MonadBlobStore m, IsProtocolVersion pv) => BlobStorable m (AccountsInCooldownForPV pv) where
+    load = case sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv)) of
+        SFalse -> return (return (AccountsInCooldownForPV CFalse))
+        STrue -> fmap (AccountsInCooldownForPV . CTrue) <$> load
+    storeUpdate aicPV@(AccountsInCooldownForPV CFalse) = do
+        return (return (), aicPV)
+    storeUpdate (AccountsInCooldownForPV (CTrue aic)) = do
+        (paic, aic') <- storeUpdate aic
+        return (paic, AccountsInCooldownForPV (CTrue aic'))
+
+-- | A lens for accessing the 'AccountsInCooldown' in an 'AccountsInCooldownForPV' when the
+--  protocol version supports flexible cooldown.
+accountsInCooldown ::
+    (PVSupportsFlexibleCooldown pv) =>
+    Lens' (AccountsInCooldownForPV pv) AccountsInCooldown
+accountsInCooldown =
+    lens
+        (uncond . theAccountsInCooldownForPV)
+        (\_ aic -> AccountsInCooldownForPV (CTrue aic))
+
+-- | An 'AccountsInCooldownForPV' with no accounts in (pre)*cooldown.
+emptyAccountsInCooldownForPV ::
+    forall pv.
+    (IsProtocolVersion pv) =>
+    AccountsInCooldownForPV pv
+emptyAccountsInCooldownForPV =
+    AccountsInCooldownForPV (conditionally cond emptyAccountsInCooldown)
+  where
+    cond = sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv))
+
+instance (MonadBlobStore m) => Cacheable m (AccountsInCooldownForPV pv) where
+    cache = fmap AccountsInCooldownForPV . mapM cache . theAccountsInCooldownForPV
+
+-- | Generate the initial 'AccountsInCooldownForPV' structure from the initial accounts.
+initialAccountsInCooldown ::
+    forall pv m.
+    (MonadBlobStore m, IsProtocolVersion pv) =>
+    [PersistentAccount (AccountVersionFor pv)] ->
+    m (AccountsInCooldownForPV pv)
+initialAccountsInCooldown accounts = case sSupportsFlexibleCooldown sAV of
+    SFalse -> return emptyAccountsInCooldownForPV
+    STrue -> do
+        AccountsInCooldownForPV . CTrue
+            <$> foldM checkAccount emptyAccountsInCooldown (zip [0 ..] accounts)
+  where
+    sAV = accountVersion @(AccountVersionFor pv)
+    checkAccount aic (aid, acct) = do
+        accountCooldowns acct >>= \case
+            Nothing -> return aic
+            Just accCooldowns -> do
+                newCooldown <- case Map.lookupMin (CooldownQueue.inCooldown accCooldowns) of
+                    Nothing -> return $ aic ^. cooldown
+                    Just (ts, _) -> addAccountRelease ts aid (aic ^. cooldown)
+                newPreCooldown <- case CooldownQueue.preCooldown accCooldowns of
+                    Absent -> return $ aic ^. preCooldown
+                    Present _ -> consAccountList aid (aic ^. preCooldown)
+                newPrePreCooldown <- case CooldownQueue.prePreCooldown accCooldowns of
+                    Absent -> return $ aic ^. prePreCooldown
+                    Present _ -> consAccountList aid (aic ^. prePreCooldown)
+                return $
+                    aic
+                        & cooldown .~ newCooldown
+                        & preCooldown .~ newPreCooldown
+                        & prePreCooldown .~ newPrePreCooldown
+
+-- | Migrate an 'AccountsInCooldownForPV'.
+--
+--   * If the new protocol version (@pv@) does not support flexible cooldown, then this just
+--     produces the 'emptyAccountsInCooldownForPV'.
+--
+--   * Otherwise, if the old protocol version (@oldpv@) does not support flexible cooldown, then
+--     this produces an 'emptyAccountsInCooldownForPV' but with the 'prePreCooldown' accounts set
+--     to the provided list.
+--
+--   * If both protocol versions support flexible cooldown, the 'AccountsInCooldown' structure is
+--     simply migrated across unchanged.
+migrateAccountsInCooldownForPV ::
+    forall oldpv pv t m.
+    (SupportMigration m t, IsProtocolVersion pv, IsProtocolVersion oldpv) =>
+    Conditionally
+        ( Not (SupportsFlexibleCooldown (AccountVersionFor oldpv))
+            && SupportsFlexibleCooldown (AccountVersionFor pv)
+        )
+        AccountList ->
+    AccountsInCooldownForPV oldpv ->
+    t m (AccountsInCooldownForPV pv)
+migrateAccountsInCooldownForPV =
+    case sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv)) of
+        SFalse -> \_ _ -> return emptyAccountsInCooldownForPV
+        STrue -> case sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor oldpv)) of
+            SFalse -> \(CTrue prePreCooldownAccts) _ ->
+                return
+                    ( AccountsInCooldownForPV
+                        (CTrue (emptyAccountsInCooldown{_prePreCooldown = prePreCooldownAccts}))
+                    )
+            STrue -> \_ (AccountsInCooldownForPV (CTrue oldAIC)) ->
+                AccountsInCooldownForPV . CTrue <$> migrateAccountsInCooldown oldAIC
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Genesis.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Genesis.hs
index 6139f2861..0f8858682 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Genesis.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Genesis.hs
@@ -26,6 +26,7 @@ import qualified Concordium.GlobalState.Persistent.BlobStore as Blob
 import qualified Concordium.GlobalState.Persistent.BlockState as BS
 import qualified Concordium.GlobalState.Persistent.BlockState.Modules as Modules
 import qualified Concordium.GlobalState.Persistent.BlockState.Updates as Updates
+import qualified Concordium.GlobalState.Persistent.Cooldown as Cooldown
 import qualified Concordium.GlobalState.Persistent.Instances as Instances
 import qualified Concordium.GlobalState.Persistent.LFMBTree as LFMBT
 import qualified Concordium.GlobalState.Persistent.PoolRewards as Rewards
@@ -243,6 +244,7 @@ buildGenesisBlockState vcgp GenesisData.GenesisState{..} = do
                   bspTransactionOutcomes = BS.emptyPersistentTransactionOutcomes,
                   bspUpdates = updates,
                   bspReleaseSchedule = releaseSchedule,
+                  bspAccountsInCooldown = Cooldown.emptyAccountsInCooldownForPV,
                   bspRewardDetails = rewardDetails
                 }
     bps <- MTL.liftIO $ newIORef $! bsp
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/ReleaseSchedule.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/ReleaseSchedule.hs
index 0b4780927..9be4e8cd8 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/ReleaseSchedule.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/ReleaseSchedule.hs
@@ -224,6 +224,41 @@ instance (MonadBlobStore m) => ReleaseScheduleOperations m NewReleaseSchedule wh
                         newMap <- Trie.delete minTS m
                         go (accum ++ Set.toList (theAccountSet accs)) newMap
 
+-- | A release schedule with no entries.
+emptyNewReleaseSchedule :: NewReleaseSchedule
+emptyNewReleaseSchedule =
+    NewReleaseSchedule
+        { nrsFirstTimestamp = Timestamp maxBound,
+          nrsMap = Trie.empty
+        }
+
+-- | Migrate a 'NewReleaseSchedule' from one 'BlobStore' to another.
+migrateNewReleaseSchedule :: (SupportMigration m t) => NewReleaseSchedule -> t m NewReleaseSchedule
+migrateNewReleaseSchedule rs = do
+    newMap <- Trie.migrateTrieN True return (nrsMap rs)
+    return $!
+        NewReleaseSchedule
+            { nrsFirstTimestamp = nrsFirstTimestamp rs,
+              nrsMap = newMap
+            }
+
+removeAccountFromReleaseSchedule :: (MonadBlobStore m) => Timestamp -> AccountIndex -> NewReleaseSchedule -> m NewReleaseSchedule
+removeAccountFromReleaseSchedule ts ai rs = do
+    (_, nrsMap) <- Trie.adjust remAcc ts (nrsMap rs)
+    newMin <- Trie.findMin nrsMap
+    case newMin of
+        Nothing -> return $! emptyNewReleaseSchedule
+        Just (nrsFirstTimestamp, _) -> return $! NewReleaseSchedule{..}
+  where
+    remAcc Nothing = error "removeAccountFromReleaseSchedule: no entry at expected release time"
+    remAcc (Just (AccountSet accs)) =
+        return $!
+            let accs' = Set.delete ai accs
+            in  if Set.null accs' then ((), Trie.Remove) else ((), Trie.Insert (AccountSet accs'))
+
+updateAccountFromReleaseSchedule :: (MonadBlobStore m) => Timestamp -> Timestamp -> AccountIndex -> NewReleaseSchedule -> m NewReleaseSchedule
+updateAccountFromReleaseSchedule = updateAccountRelease
+
 -- | A reference to an account used in the top-level release schedule.
 --  For protocol version prior to 'P5', this is 'AccountAddress', and for 'P5' onward this is
 --  'AccountIndex'. This type determines the implementation of the release schedule use for the
@@ -310,10 +345,7 @@ emptyReleaseSchedule = case protocolVersion @pv of
     rsP1 = do
         return $!
             ReleaseScheduleP5
-                NewReleaseSchedule
-                    { nrsFirstTimestamp = Timestamp maxBound,
-                      nrsMap = Trie.empty
-                    }
+                emptyNewReleaseSchedule
 
 -- | Migration information for a release schedule.
 data ReleaseScheduleMigration m oldpv pv where
@@ -372,13 +404,7 @@ migrateReleaseSchedule (RSMLegacyToNew resolveAcc) (ReleaseScheduleP0 rsRef) = d
                   nrsMap = newMap'
                 }
 migrateReleaseSchedule RSMNewToNew (ReleaseScheduleP5 rs) = do
-    newMap <- Trie.migrateTrieN True return (nrsMap rs)
-    return $!
-        ReleaseScheduleP5
-            NewReleaseSchedule
-                { nrsFirstTimestamp = nrsFirstTimestamp rs,
-                  nrsMap = newMap
-                }
+    ReleaseScheduleP5 <$> migrateNewReleaseSchedule rs
 
 -- | (For testing purposes) get the map of the earliest scheduled releases of each account.
 releasesMap ::
diff --git a/concordium-consensus/tests/globalstate/GlobalStateTests/AccountsMigrationP6ToP7.hs b/concordium-consensus/tests/globalstate/GlobalStateTests/AccountsMigrationP6ToP7.hs
new file mode 100644
index 000000000..81674183a
--- /dev/null
+++ b/concordium-consensus/tests/globalstate/GlobalStateTests/AccountsMigrationP6ToP7.hs
@@ -0,0 +1,368 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE MonoLocalBinds #-}
+{-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+-- | This module tests the migration of accounts from protocol version 6 to protocol version 7.
+-- In particular, it tests that bakers and delegators are migrated correctly, with any bakers
+-- or delegators that are in cooldown (for removal or stake reduction) are moved to cooldown after
+-- migration. Specifically:
+--
+--  * Bakers/delegators that are in cooldown for removal are removed and have their stake put in
+--    pre-pre-cooldown.
+--  * Bakers/delegators that are in cooldown for reduction have their stake reduced and the
+--    reduction put in pre-pre-cooldown.
+--  * Any account that is put in pre-pre-cooldown is recorded in 'migrationPrePreCooldown'.
+--  * Delegators to bakers that are removed (as a result of migration) are moved to passive
+--    delegation.
+--  * All bakers and delegators that are not removed are correctly recorded in the persistent
+--    active bakers.
+module GlobalStateTests.AccountsMigrationP6ToP7 where
+
+import Test.HUnit
+import Test.Hspec
+
+import Concordium.Types
+import Concordium.Types.Accounts
+
+import qualified Concordium.Crypto.BlockSignature as Sig
+import qualified Concordium.Crypto.BlsSignature as Bls
+import qualified Concordium.Crypto.VRF as VRF
+import Concordium.Genesis.Data
+import Concordium.GlobalState.Account
+import qualified Concordium.GlobalState.AccountMap.LMDB as LMDBAccountMap
+import qualified Concordium.GlobalState.Basic.BlockState.Account as Transient
+import qualified Concordium.GlobalState.Basic.BlockState.AccountReleaseSchedule as Transient
+import Concordium.GlobalState.CooldownQueue
+import Concordium.GlobalState.DummyData
+import Concordium.GlobalState.Persistent.Account
+import qualified Concordium.GlobalState.Persistent.Account.MigrationState as MigrationState
+import Concordium.GlobalState.Persistent.Accounts
+import Concordium.GlobalState.Persistent.Bakers
+import Concordium.GlobalState.Persistent.BlobStore
+import Concordium.GlobalState.Persistent.BlockState
+import qualified Concordium.GlobalState.Persistent.BlockState.Modules as M
+import Concordium.GlobalState.Persistent.Cooldown
+import qualified Concordium.GlobalState.Persistent.Trie as Trie
+import Concordium.ID.Types
+import Concordium.Scheduler.DummyData
+import Concordium.Types.Conditionally
+import Concordium.Types.DummyData
+import Concordium.Types.Execution
+import Concordium.Types.Option
+import Control.Exception
+import Control.Monad
+import Control.Monad.IO.Class
+import qualified Data.Map.Strict as Map
+import GlobalStateTests.Accounts (NoLoggerT (..))
+import Lens.Micro.Platform
+import System.FilePath
+import System.IO.Temp
+
+dummyPersisingAccountData :: Int -> PersistingAccountData
+dummyPersisingAccountData seed =
+    PersistingAccountData
+        { _accountAddress = addr,
+          _accountEncryptionKey = encryptionKey,
+          _accountVerificationKeys = getAccountInformation 1 creds,
+          _accountCredentials = creds,
+          _accountRemovedCredentials = makeHashed EmptyRemovedCredentials
+        }
+  where
+    cred = makeTestCredentialFromSeed seed
+    creds = Map.singleton 0 (toRawAccountCredential cred)
+    addr = accountAddressFromSeed seed
+    encryptionKey = toRawEncryptionKey (makeEncryptionKey dummyCryptographicParameters (credId cred))
+
+-- | Create a test account with the given persisting data and stake.
+--  The balance of the account is set to 1 billion CCD (10^15 uCCD).
+testAccount ::
+    forall av.
+    (IsAccountVersion av) =>
+    PersistingAccountData ->
+    AccountStake av ->
+    Transient.Account av
+testAccount persisting stake =
+    Transient.Account
+        { _accountPersisting = Transient.makeAccountPersisting persisting,
+          _accountNonce = minNonce,
+          _accountAmount = 1_000_000_000_000_000,
+          _accountEncryptedAmount = initialAccountEncryptedAmount,
+          _accountReleaseSchedule = Transient.emptyAccountReleaseSchedule,
+          _accountStaking = stake,
+          _accountStakeCooldown = Transient.emptyCooldownQueue (accountVersion @av)
+        }
+
+-- | Initial stake for a test account, set to 500 million CCD plus @2^accountIndex@ uCCD.
+initialStake :: AccountIndex -> Amount
+initialStake accIndex = 500_000_000_000_000 + 2 ^ accIndex
+
+-- | Target reduced stake for a test account, set to 10_000 CCD plus @2^accountIndex@ uCCD.
+reducedStake :: AccountIndex -> Amount
+reducedStake accIndex = 10_000_000_000 + 2 ^ accIndex
+
+-- | Create a baker stake for a given (small (<38)) account index. The stake is set at 500 million
+-- CCD plus @2^accountIndex@ uCCD. This is to ensure that any given combination of accounts have a
+-- unique total stake.
+dummyBakerStake ::
+    (AVSupportsDelegation av) =>
+    (AccountIndex -> Amount) ->
+    AccountIndex ->
+    StakePendingChange av ->
+    AccountStake av
+dummyBakerStake compStake accIndex pc =
+    AccountStakeBaker $
+        AccountBaker
+            { _stakedAmount = compStake accIndex,
+              _stakeEarnings = True,
+              _bakerPendingChange = pc,
+              _accountBakerInfo =
+                BakerInfoExV1
+                    { _bieBakerPoolInfo =
+                        BakerPoolInfo
+                            { _poolOpenStatus = OpenForAll,
+                              _poolMetadataUrl = emptyUrlText,
+                              _poolCommissionRates =
+                                CommissionRates
+                                    { _finalizationCommission = makeAmountFraction 50_000,
+                                      _bakingCommission = makeAmountFraction 50_000,
+                                      _transactionCommission = makeAmountFraction 50_000
+                                    }
+                            },
+                      _bieBakerInfo =
+                        BakerInfo
+                            { _bakerSignatureVerifyKey = Sig.verifyKey (bakerSignKey seed),
+                              _bakerIdentity = BakerId accIndex,
+                              _bakerElectionVerifyKey = VRF.publicKey (bakerElectionKey seed),
+                              _bakerAggregationVerifyKey =
+                                Bls.derivePublicKey (bakerAggregationKey seed)
+                            }
+                    }
+            }
+  where
+    seed = fromIntegral accIndex
+
+dummyDelegatorStake ::
+    (AVSupportsDelegation av) =>
+    (AccountIndex -> Amount) ->
+    AccountIndex ->
+    DelegationTarget ->
+    StakePendingChange av ->
+    AccountStake av
+dummyDelegatorStake compStake accIndex target pc =
+    AccountStakeDelegate $
+        AccountDelegationV1
+            { _delegationTarget = target,
+              _delegationStakedAmount = compStake accIndex,
+              _delegationStakeEarnings = True,
+              _delegationPendingChange = pc,
+              _delegationIdentity = DelegatorId accIndex
+            }
+
+-- | Create a set of test accounts for migration testing.
+--  The accounts consist of 3 bakers, one with no pending changes, one with a reduction and one
+--  with a removal. Each baker has 3 delegators, one with no pending changes, one with a reduction
+--  and one with a removal. There are also 3 passive delegators, similarly configured.
+setupTestAccounts :: (SupportsPersistentAccount 'P6 m, MonadFail m) => m (Accounts 'P6)
+setupTestAccounts = do
+    a0 <- mkBakerAccount 0 NoChange
+    a1 <- mkBakerAccount 1 (ReduceStake (reducedStake 1) (PendingChangeEffectiveV1 1000))
+    a2 <- mkBakerAccount 2 (RemoveStake (PendingChangeEffectiveV1 2000))
+    a3 <- mkDelegatorAccount 3 (DelegateToBaker 0) NoChange
+    a4 <-
+        mkDelegatorAccount
+            4
+            (DelegateToBaker 0)
+            (ReduceStake (reducedStake 4) (PendingChangeEffectiveV1 3000))
+    a5 <- mkDelegatorAccount 5 (DelegateToBaker 0) (RemoveStake (PendingChangeEffectiveV1 4000))
+    a6 <- mkDelegatorAccount 6 (DelegateToBaker 1) NoChange
+    a7 <-
+        mkDelegatorAccount
+            7
+            (DelegateToBaker 1)
+            (ReduceStake (reducedStake 7) (PendingChangeEffectiveV1 5000))
+    a8 <- mkDelegatorAccount 8 (DelegateToBaker 1) (RemoveStake (PendingChangeEffectiveV1 6000))
+    a9 <- mkDelegatorAccount 9 (DelegateToBaker 2) NoChange
+    a10 <-
+        mkDelegatorAccount
+            10
+            (DelegateToBaker 2)
+            (ReduceStake (reducedStake 10) (PendingChangeEffectiveV1 7000))
+    a11 <- mkDelegatorAccount 11 (DelegateToBaker 2) (RemoveStake (PendingChangeEffectiveV1 8000))
+    a12 <- mkDelegatorAccount 12 DelegatePassive NoChange
+    a13 <-
+        mkDelegatorAccount
+            13
+            DelegatePassive
+            (ReduceStake (reducedStake 13) (PendingChangeEffectiveV1 9000))
+    a14 <- mkDelegatorAccount 14 DelegatePassive (RemoveStake (PendingChangeEffectiveV1 10_000))
+    accounts0 <- emptyAccounts
+    foldM
+        (\accts a -> snd <$> putNewAccount a accts)
+        accounts0
+        [a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14]
+  where
+    mkBakerAccount accIdx pc =
+        makePersistentAccount $
+            testAccount
+                (dummyPersisingAccountData (fromIntegral accIdx))
+                (dummyBakerStake initialStake accIdx pc)
+    mkDelegatorAccount accIndex target pc =
+        makePersistentAccount $
+            testAccount
+                (dummyPersisingAccountData (fromIntegral accIndex))
+                (dummyDelegatorStake initialStake accIndex target pc)
+
+initPersistentActiveBakers ::
+    forall pv m.
+    (SupportsPersistentAccount pv m, PVSupportsDelegation pv) =>
+    Accounts pv ->
+    m (PersistentActiveBakers (AccountVersionFor pv))
+initPersistentActiveBakers = foldAccounts addAcct emptyPersistentActiveBakers
+  where
+    addAcct pab acct =
+        accountStake acct >>= \case
+            AccountStakeNone -> return pab
+            AccountStakeBaker b -> do
+                let upd Nothing = return ((), Trie.Insert emptyPersistentActiveDelegators)
+                    upd _ = return ((), Trie.NoChange)
+                (_, newActiveBakers) <- Trie.adjust upd (b ^. bakerIdentity) (pab ^. activeBakers)
+                newAggregationKeys <-
+                    Trie.insert (b ^. bakerAggregationVerifyKey) () (pab ^. aggregationKeys)
+                return $!
+                    pab
+                        & activeBakers .~ newActiveBakers
+                        & totalActiveCapital . tacAmount +~ (b ^. stakedAmount)
+                        & aggregationKeys .~ newAggregationKeys
+            AccountStakeDelegate d -> do
+                (totalActiveCapital . tacAmount +~ delAmt)
+                    <$> case d ^. delegationTarget of
+                        DelegatePassive -> do
+                            passiveDelegators (addDelegatorHelper delId delAmt) pab
+                        DelegateToBaker bid -> do
+                            activeBakers (fmap snd . Trie.adjust upd bid) pab
+              where
+                delId = d ^. delegationIdentity
+                delAmt = d ^. delegationStakedAmount
+                upd Nothing = do
+                    singletonPAD <-
+                        addDelegatorHelper delId delAmt emptyPersistentActiveDelegators
+                    return ((), Trie.Insert singletonPAD)
+                upd (Just pad) = do
+                    newPAD <- addDelegatorHelper delId delAmt pad
+                    return ((), Trie.Insert newPAD)
+
+migrationTest :: PersistentBlockStateContext 'P6 -> PersistentBlockStateContext 'P7 -> Expectation
+migrationTest c0 c1 = runNoLoggerT $ flip runBlobStoreT c0 $ do
+    accounts <- setupTestAccounts
+    pab <- initPersistentActiveBakers accounts
+    flip runBlobStoreT c1 $ do
+        initMigrationState :: MigrationState.AccountMigrationState 'P6 'P7 <-
+            MigrationState.makeInitialAccountMigrationState accounts pab
+
+        (newAccounts :: Accounts 'P7, newMigrationState) <-
+            MigrationState.runAccountMigrationStateTT
+                (migrateAccounts @'P6 @'P7 StateMigrationParametersP6ToP7 accounts)
+                initMigrationState
+        assertMigrationStateCorrect newMigrationState
+        assertAccountsCorrect newAccounts
+        unless (accountDiffMapRef accounts == accountDiffMapRef newAccounts) $
+            liftIO $
+                assertFailure "Expected the same account difference map"
+
+-- | Assert that the accounts marked as in pre-pre-cooldown and the persistent active bakers are as
+--  expected after migration from the test accounts.
+assertMigrationStateCorrect :: forall m. (MonadBlobStore m) => MigrationState.AccountMigrationState 'P6 'P7 -> m ()
+assertMigrationStateCorrect migrationState = do
+    prePreCooldownList <- loadAccountList (migrationState ^. MigrationState.migrationPrePreCooldown . unconditionally)
+    -- All accounts that were in cooldown before migration should be in pre-pre-cooldown after migration.
+    let expectPrePreCooldownList = [14, 13, 11, 10, 8, 7, 5, 4, 2, 1]
+    liftIO $ assertEqual "Expected pre-pre-cooldown list" expectPrePreCooldownList prePreCooldownList
+    let pab = migrationState ^. MigrationState.persistentActiveBakers . unconditionally
+    let unDel :: PersistentActiveDelegators 'AccountV3 -> m ([DelegatorId], Amount)
+        unDel PersistentActiveDelegatorsV1{..} = (,adDelegatorTotalCapital) <$> Trie.keysAsc adDelegators
+    actBkrs <- mapM unDel =<< Trie.toMap (pab ^. activeBakers)
+    let expectActiveBakers =
+            Map.fromList
+                [ (0, ([3, 4], initialStake 3 + reducedStake 4)),
+                  (1, ([6, 7], initialStake 6 + reducedStake 7))
+                ]
+    liftIO $ assertEqual "Active bakers" expectActiveBakers actBkrs
+    aggKeys <- Trie.keys (pab ^. aggregationKeys)
+    -- Note: the aggregation keys happen to be in this order. Technically the order doesn't matter.
+    let expectAggreationKeys = Bls.derivePublicKey . bakerAggregationKey <$> [0, 1]
+    liftIO $ assertEqual "Aggregation keys" expectAggreationKeys aggKeys
+    pasvDlg <- unDel (pab ^. passiveDelegators)
+    let expectPassiveDelegators = ([9, 10, 12, 13], initialStake 9 + reducedStake 10 + initialStake 12 + reducedStake 13)
+    liftIO $ assertEqual "Passive delegators" expectPassiveDelegators pasvDlg
+    let actCapital = pab ^. totalActiveCapital . tacAmount
+    let expectTotalActiveCapital = sum (initialStake <$> [0, 3, 6, 9, 12]) + sum (reducedStake <$> [1, 4, 7, 10, 13])
+    liftIO $ assertEqual "Total active capital" expectTotalActiveCapital actCapital
+
+assertAccountsCorrect :: forall m. (SupportsPersistentAccount 'P7 m, MonadFail m) => Accounts 'P7 -> m ()
+assertAccountsCorrect accounts = do
+    accountExpect 0 (dummyBakerStake initialStake 0 NoChange) Nothing
+    accountExpect 1 (dummyBakerStake reducedStake 1 NoChange) (prePreExpect (cooldownReduce 1))
+    accountExpect 2 AccountStakeNone (prePreExpect (initialStake 2))
+    accountExpect 3 (dummyDelegatorStake initialStake 3 (DelegateToBaker 0) NoChange) Nothing
+    accountExpect 4 (dummyDelegatorStake reducedStake 4 (DelegateToBaker 0) NoChange) (prePreExpect (cooldownReduce 4))
+    accountExpect 5 AccountStakeNone (prePreExpect (initialStake 5))
+    accountExpect 6 (dummyDelegatorStake initialStake 6 (DelegateToBaker 1) NoChange) Nothing
+    accountExpect 7 (dummyDelegatorStake reducedStake 7 (DelegateToBaker 1) NoChange) (prePreExpect (cooldownReduce 7))
+    accountExpect 8 AccountStakeNone (prePreExpect (initialStake 8))
+    accountExpect 9 (dummyDelegatorStake initialStake 9 DelegatePassive NoChange) Nothing
+    accountExpect 10 (dummyDelegatorStake reducedStake 10 DelegatePassive NoChange) (prePreExpect (cooldownReduce 10))
+    accountExpect 11 AccountStakeNone (prePreExpect (initialStake 11))
+    accountExpect 12 (dummyDelegatorStake initialStake 12 DelegatePassive NoChange) Nothing
+    accountExpect 13 (dummyDelegatorStake reducedStake 13 DelegatePassive NoChange) (prePreExpect (cooldownReduce 13))
+    accountExpect 14 AccountStakeNone (prePreExpect (initialStake 14))
+  where
+    availableExpect accIndex = 1_000_000_000_000_000 - initialStake accIndex
+    cooldownReduce accIndex = initialStake accIndex - reducedStake accIndex
+    prePreExpect amt =
+        Just
+            ( Cooldowns
+                { inCooldown = Map.empty,
+                  preCooldown = Absent,
+                  prePreCooldown = Present amt
+                }
+            )
+    accountExpect accIndex expectStake expectCooldowns = do
+        (Just a) <- indexedAccount accIndex accounts
+        liftIO . assertEqual ("Account " ++ show accIndex ++ " stake") expectStake
+            =<< accountStake a
+        liftIO . assertEqual ("Account " ++ show accIndex ++ " cooldowns") expectCooldowns
+            =<< accountCooldowns a
+        liftIO . assertEqual ("Account " ++ show accIndex ++ " available amount") (availableExpect accIndex)
+            =<< accountAvailableAmount a
+
+tests :: Spec
+tests = describe "GlobalStateTests.AccountsMigrationP6ToP7"
+    $ around
+        ( \kont ->
+            withTempDirectory "." "blockstate" $ \dir ->
+                bracket
+                    ( do
+                        c0 <- createPBSC dir "0"
+                        c1 <- createPBSC dir "1"
+                        return (c0, c1)
+                    )
+                    ( \(c0, c1) -> do
+                        destroyPBSC c0
+                        destroyPBSC c1
+                    )
+                    kont
+        )
+    $ do
+        it "migration" (uncurry migrationTest)
+  where
+    createPBSC dir i = do
+        pbscBlobStore <- createBlobStore (dir </> ("blockstate" ++ i ++ ".dat"))
+        pbscAccountCache <- newAccountCache 100
+        pbscModuleCache <- M.newModuleCache 100
+        pbscAccountMap <- LMDBAccountMap.openDatabase (dir </> ("accountmap" ++ i))
+        return PersistentBlockStateContext{..}
+    destroyPBSC PersistentBlockStateContext{..} = do
+        closeBlobStore pbscBlobStore
+        LMDBAccountMap.closeDatabase pbscAccountMap
diff --git a/concordium-consensus/tests/globalstate/Spec.hs b/concordium-consensus/tests/globalstate/Spec.hs
index 79a63b211..11b49943a 100644
--- a/concordium-consensus/tests/globalstate/Spec.hs
+++ b/concordium-consensus/tests/globalstate/Spec.hs
@@ -6,6 +6,7 @@ import qualified GlobalStateTests.AccountMap (tests)
 import qualified GlobalStateTests.AccountReleaseScheduleMigration (tests)
 import qualified GlobalStateTests.AccountReleaseScheduleTest (tests)
 import qualified GlobalStateTests.Accounts (tests)
+import qualified GlobalStateTests.AccountsMigrationP6ToP7 (tests)
 import qualified GlobalStateTests.BlobStore (tests)
 import qualified GlobalStateTests.BlockHash (tests)
 import qualified GlobalStateTests.Cache (tests)
@@ -52,4 +53,5 @@ main = atLevel $ \lvl -> hspec $ do
     GlobalStateTests.UpdateQueues.tests
     GlobalStateTests.LMDBAccountMap.tests
     GlobalStateTests.DifferenceMap.tests
+    GlobalStateTests.AccountsMigrationP6ToP7.tests
     GlobalStateTests.CooldownQueue.tests

From aa77fad345a0dfa2502c3eae13520589e481fc47 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Mon, 5 Aug 2024 13:27:05 +0200
Subject: [PATCH 52/81] Cooldown processing and epoch transitions.

---
 .../src/Concordium/GlobalState/Account.hs     |  21 +
 .../src/Concordium/GlobalState/BlockState.hs  |  28 +-
 .../GlobalState/Persistent/BlockState.hs      |  75 ++
 .../src/Concordium/KonsensusV1/Scheduler.hs   |  61 +-
 .../src/Concordium/Kontrol/Bakers.hs          |  31 +-
 .../Scheduler/TreeStateEnvironment.hs         |   3 +-
 .../GlobalStateTests/BlockStateHelpers.hs     | 197 +++++
 .../GlobalStateTests/CooldownProcessing.hs    |  93 +++
 .../tests/globalstate/Spec.hs                 |   2 +
 .../KonsensusV1/EpochTransition.hs            | 688 ++++++++++++++++++
 concordium-consensus/tests/scheduler/Spec.hs  |   3 +
 11 files changed, 1184 insertions(+), 18 deletions(-)
 create mode 100644 concordium-consensus/tests/globalstate/GlobalStateTests/BlockStateHelpers.hs
 create mode 100644 concordium-consensus/tests/globalstate/GlobalStateTests/CooldownProcessing.hs
 create mode 100644 concordium-consensus/tests/scheduler/SchedulerTests/KonsensusV1/EpochTransition.hs

diff --git a/concordium-consensus/src/Concordium/GlobalState/Account.hs b/concordium-consensus/src/Concordium/GlobalState/Account.hs
index 3544fbbb0..651e70a1e 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Account.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Account.hs
@@ -555,3 +555,24 @@ data StakeDetails (av :: AccountVersion) where
           sdDelegationTarget :: !DelegationTarget
         } ->
         StakeDetails av
+
+instance Show (StakeDetails av) where
+    show StakeDetailsNone = "StakeDetailsNone"
+    show StakeDetailsBaker{..} =
+        "StakeDetailsBaker {sdStakedCapital = "
+            <> show sdStakedCapital
+            <> ", sdRestakeEarnings = "
+            <> show sdRestakeEarnings
+            <> ", sdPendingChange = "
+            <> show sdPendingChange
+            <> "}"
+    show StakeDetailsDelegator{..} =
+        "StakeDetailsDelegator {sdStakedCapital = "
+            <> show sdStakedCapital
+            <> ", sdRestakeEarnings = "
+            <> show sdRestakeEarnings
+            <> ", sdPendingChange = "
+            <> show sdPendingChange
+            <> ", sdDelegationTarget = "
+            <> show sdDelegationTarget
+            <> "}"
diff --git a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs
index 0e6cf18a4..16e9dc24c 100644
--- a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs
@@ -899,12 +899,36 @@ class (BlockStateQuery m) => BlockStateOperations m where
     --  the delegation from the active bakers index.
     --  For delegators pending stake reduction, this reduces the stake.
     bsoProcessPendingChanges ::
-        (PVSupportsDelegation (MPV m)) =>
+        ( PVSupportsDelegation (MPV m),
+          SupportsFlexibleCooldown (AccountVersionFor (MPV m)) ~ 'False
+        ) =>
         UpdatableBlockState m ->
         -- | Guard determining if a change is effective
         (Timestamp -> Bool) ->
         m (UpdatableBlockState m)
 
+    -- | Process cooldowns on accounts that have expired, and move pre-cooldowns into cooldown.
+    --  All cooldowns that expire at or before the given expiry time will be removed from accounts.
+    --  After this, all pre-cooldowns on accounts are moved into cooldown.
+    bsoProcessCooldowns ::
+        (PVSupportsFlexibleCooldown (MPV m)) =>
+        UpdatableBlockState m ->
+        -- | Timestamp for expiring cooldowns.
+        Timestamp ->
+        -- | Timestamp for pre-cooldowns entering cooldown.
+        Timestamp ->
+        m (UpdatableBlockState m)
+
+    -- | Move all pre-pre-cooldowns into pre-cooldown.
+    --  It is assumed that there are currently no pre-cooldowns. This should be ensured by
+    --  calling 'bsoProcessCooldowns' between successive calls to 'bsoProcessPrePreCooldowns', as
+    --  that moves all pre-cooldowns into cooldown, and only 'bsoProcessPrePreCooldowns' moves
+    --  anything into pre-cooldown.
+    bsoProcessPrePreCooldowns ::
+        (PVSupportsFlexibleCooldown (MPV m)) =>
+        UpdatableBlockState m ->
+        m (UpdatableBlockState m)
+
     -- | Get the list of all active bakers in ascending order.
     bsoGetActiveBakers :: UpdatableBlockState m -> m [BakerId]
 
@@ -1614,6 +1638,8 @@ instance (Monad (t m), MonadTrans t, BlockStateOperations m) => BlockStateOperat
     bsoSetSeedState s ss = lift $ bsoSetSeedState s ss
     bsoRotateCurrentEpochBakers = lift . bsoRotateCurrentEpochBakers
     bsoProcessPendingChanges s g = lift $ bsoProcessPendingChanges s g
+    bsoProcessCooldowns s expiry cooldown = lift $ bsoProcessCooldowns s expiry cooldown
+    bsoProcessPrePreCooldowns = lift . bsoProcessPrePreCooldowns
     bsoTransitionEpochBakers s e = lift $ bsoTransitionEpochBakers s e
     bsoGetActiveBakers = lift . bsoGetActiveBakers
     bsoGetActiveBakersAndDelegators = lift . bsoGetActiveBakersAndDelegators
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
index c5b2a581d..8f6d4a5ec 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
@@ -23,6 +23,7 @@ module Concordium.GlobalState.Persistent.BlockState (
     HashedPersistentBlockState (..),
     hashBlockState,
     PersistentBirkParameters (..),
+    initialBirkParameters,
     initialPersistentState,
     emptyBlockState,
     emptyHashedEpochBlocks,
@@ -37,6 +38,8 @@ module Concordium.GlobalState.Persistent.BlockState (
     cacheStateAndGetTransactionTable,
     migratePersistentBlockState,
     SupportsPersistentState,
+    loadPBS,
+    storePBS,
 ) where
 
 import qualified Concordium.Crypto.SHA256 as H
@@ -995,10 +998,12 @@ emptyBlockState bspBirkParameters cryptParams keysCollection chainParams = do
                 }
     liftIO $ newIORef $! bsp
 
+-- | Load 'BlockStatePointers' from a 'PersistentBlockState'.
 loadPBS :: (SupportsPersistentState pv m) => PersistentBlockState pv -> m (BlockStatePointers pv)
 loadPBS = loadBufferedRef <=< liftIO . readIORef
 {-# INLINE loadPBS #-}
 
+-- | Update the 'BlockStatePointers' stored in a 'PersistentBlockState'.
 storePBS :: (SupportsPersistentAccount pv m) => PersistentBlockState pv -> BlockStatePointers pv -> m (PersistentBlockState pv)
 storePBS pbs bsp = liftIO $ do
     pbsp <- makeBufferedRef bsp
@@ -3364,6 +3369,74 @@ doProcessPendingChanges persistentBS isEffective = do
         newAccounts <- lift $ Accounts.updateAccountsAtIndex' updAcc accId accounts
         _1 .=! newAccounts
 
+-- | Process cooldowns on accounts that have expired, and move pre-cooldowns into cooldown.
+doProcessCooldowns ::
+    forall pv m.
+    (SupportsPersistentState pv m, PVSupportsFlexibleCooldown pv) =>
+    PersistentBlockState pv ->
+    -- | Timestamp for expiring cooldowns.
+    Timestamp ->
+    -- | Timestamp for pre-cooldowns entering cooldown.
+    Timestamp ->
+    m (PersistentBlockState pv)
+doProcessCooldowns pbs now newExpiry = do
+    bsp <- loadPBS pbs
+    (newAIC, newAccts) <-
+        MTL.execStateT
+            process
+            (bspAccountsInCooldown bsp ^. accountsInCooldown, bspAccounts bsp)
+    storePBS pbs $
+        bsp
+            { bspAccountsInCooldown = AccountsInCooldownForPV (CTrue newAIC),
+              bspAccounts = newAccts
+            }
+  where
+    withCooldown a = (_1 . cooldown .=) =<< a =<< use (_1 . cooldown)
+    withAccounts a = (_2 .=) =<< a =<< use _2
+    process = do
+        cooldown0 <- use (_1 . cooldown)
+        (cooldownList, cooldown1) <- processReleasesUntil now cooldown0
+        _1 . cooldown .= cooldown1
+        forM_ cooldownList $ \acc -> do
+            withAccounts (Accounts.updateAccountsAtIndex' (processCooldownForAccount acc) acc)
+        preCooldownAL <- _1 . preCooldown <<.= Null
+        preCooldowns <- loadAccountList preCooldownAL
+        forM_ preCooldowns $ \acc -> do
+            withAccounts (Accounts.updateAccountsAtIndex' (processPreCooldownForAccount acc) acc)
+    processCooldownForAccount acc pa = do
+        (mNextCooldown, newPA) <- processAccountCooldownsUntil now pa
+        forM_ mNextCooldown $ \nextCooldown -> withCooldown $ addAccountRelease nextCooldown acc
+        return newPA
+    processPreCooldownForAccount acc pa = do
+        (res, newPA) <- processAccountPreCooldown newExpiry pa
+        case res of
+            Just (Just oldTS) -> withCooldown $ updateAccountRelease oldTS newExpiry acc
+            Just Nothing -> withCooldown $ addAccountRelease newExpiry acc
+            Nothing -> return ()
+        return newPA
+
+doProcessPrePreCooldowns ::
+    forall pv m.
+    (SupportsPersistentState pv m, PVSupportsFlexibleCooldown pv) =>
+    PersistentBlockState pv ->
+    m (PersistentBlockState pv)
+doProcessPrePreCooldowns pbs = do
+    bsp <- loadPBS pbs
+    let oldAIC = bspAccountsInCooldown bsp ^. accountsInCooldown
+    let !newPreCooldown = assert (isNull (oldAIC ^. preCooldown)) $ oldAIC ^. prePreCooldown
+    let newAIC =
+            oldAIC
+                & preCooldown .~ newPreCooldown
+                & prePreCooldown .~ Null
+    accounts <- loadAccountList newPreCooldown
+    let processAccount = flip $ Accounts.updateAccountsAtIndex' processAccountPrePreCooldown
+    newAccts <- foldM processAccount (bspAccounts bsp) accounts
+    storePBS pbs $
+        bsp
+            { bspAccountsInCooldown = AccountsInCooldownForPV (CTrue newAIC),
+              bspAccounts = newAccts
+            }
+
 doGetBankStatus :: (SupportsPersistentState pv m) => PersistentBlockState pv -> m Rewards.BankStatus
 doGetBankStatus pbs = _unhashed . bspBank <$> loadPBS pbs
 
@@ -3635,6 +3708,8 @@ instance (IsProtocolVersion pv, PersistentState av pv r m) => BlockStateOperatio
     bsoRotateCurrentEpochBakers = doRotateCurrentEpochBakers
     bsoSetNextEpochBakers = doSetNextEpochBakers
     bsoProcessPendingChanges = doProcessPendingChanges
+    bsoProcessCooldowns = doProcessCooldowns
+    bsoProcessPrePreCooldowns = doProcessPrePreCooldowns
     bsoGetBankStatus = doGetBankStatus
     bsoSetRewardAccounts = doSetRewardAccounts
     bsoIsProtocolUpdateEffective = doIsProtocolUpdateEffective
diff --git a/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs b/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs
index e86508bd2..cabe27442 100644
--- a/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs
+++ b/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs
@@ -1,11 +1,13 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE EmptyDataDeriving #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 
 module Concordium.KonsensusV1.Scheduler where
 
 import Control.Monad
+import Data.Bool.Singletons
 import qualified Data.Map as Map
 import Data.Time
 import Lens.Micro.Platform
@@ -48,6 +50,7 @@ data PaydayParameters = PaydayParameters
       -- | The mint rate for the payday.
       paydayMintRate :: MintRate
     }
+    deriving (Show, Eq)
 
 -- | The bakers that participated in the block. Used for determining rewards.
 --
@@ -114,6 +117,31 @@ data PrologueResult m = PrologueResult
 
 -- * Block prologue
 
+-- | Handle cooldown events for a payday. Prior to protocol version 7, the cooldowns are processed
+--  with 'bsoProcessPendingChanges': bakers and delegators that have a cooldown that elapses by the
+--  trigger time of the previous epoch are processed, with their funds being released and their
+--  baker/delegator status being updated as appropriate. From protocol version 7 onwards, the
+--  cooldowns are processed with 'bsoProcessCooldowns': bakers and delegators that have a cooldown
+--  that elapses by the trigger time of the previous epoch are processed, with their funds being
+--  released (their status is not updated, as it was already updated before entering cooldown);
+--  moreover, accounts that have a pre-cooldown set will enter cooldown, which expires at
+--  @triggerTime + cooldownDuration@.
+paydayHandleCooldowns ::
+    forall m.
+    (BlockStateOperations m, MonadProtocolVersion m, IsConsensusV1 (MPV m)) =>
+    -- | The trigger time of the previous epoch.
+    Timestamp ->
+    -- | The current cooldown parameters.
+    CooldownParameters (ChainParametersVersionFor (MPV m)) ->
+    UpdatableBlockState m ->
+    m (UpdatableBlockState m)
+paydayHandleCooldowns = case sSupportsFlexibleCooldown (sAccountVersionFor (protocolVersion @(MPV m))) of
+    SFalse -> \triggerTime _ theState0 -> do
+        bsoProcessPendingChanges theState0 (<= triggerTime)
+    STrue -> \triggerTime cooldownParams theState0 -> do
+        let cooldownTime = triggerTime `addDurationSeconds` (cooldownParams ^. cpUnifiedCooldown)
+        bsoProcessCooldowns theState0 triggerTime cooldownTime
+
 -- | Update the state to reflect an epoch transition.  If the block is not the first in a new epoch
 --  then this does nothing.  Otherwise, it makes the following changes:
 --
@@ -129,20 +157,24 @@ data PrologueResult m = PrologueResult
 --       - Process pending cooldowns on bakers and delegators that were set to elapse by the
 --         trigger block time for the previous epoch.
 --
+--       - (>=P7) Process pre-cooldowns on accounts, moving them into cooldown.
+--
 --   * The seed state is updated to reflect the epoch transition.
 --
 --   * If the new epoch is the epoch before the next payday, take a snapshot of bakers and
---     delegators, allowing for cooldowns that are set to elapse at by the trigger block time for
---     this epoch.
+--     delegators. Prior to protocol version 7, this accounts for cooldowns that are set to elapse
+--     by the trigger block time for this epoch. From protocol version 7, accounts in
+--     pre-pre-cooldown are moved to pre-cooldown.
 --
 --  Note: If the baker or delegator cooldown period is ever less than the duration of an epoch, then
 --  it would be possible to have a baker not in cooldown when the baker snapshot is taken, but be
 --  removed when the cooldowns are processed at the payday. This is bad, because the baker/delegator
 --  would not have their stake locked while they are baking/delegating. However, this should not be
---  a catastrophic invariant violation.
+--  a catastrophic invariant violation. (This does not apply from protocol version 7 onwards, as
+--  cooldowns are processed differently.)
 doEpochTransition ::
     forall m.
-    (BlockStateOperations m, IsConsensusV1 (MPV m)) =>
+    (BlockStateOperations m, MonadProtocolVersion m, IsConsensusV1 (MPV m)) =>
     -- | Whether the block is the first in a new epoch
     Bool ->
     -- | The epoch duration
@@ -175,9 +207,13 @@ doEpochTransition True epochDuration theState0 = do
                 theState3 <- bsoSetPaydayMintRate theState2 (timeParams ^. tpMintPerPayday)
                 let newPayday = nextPayday + rewardPeriodEpochs (timeParams ^. tpRewardPeriodLength)
                 theState4 <- bsoSetPaydayEpoch theState3 newPayday
-                -- Process bakers and delegators where the cooldown elapsed by the trigger block
-                -- time of the previous epoch.
-                theState5 <- bsoProcessPendingChanges theState4 (<= oldSeedState ^. triggerBlockTime)
+                -- Process accounts with cooldowns that elapse by the trigger block time of the
+                -- previous epoch, and (in P7 onwards) move pre-cooldowns on accounts into cooldown.
+                theState5 <-
+                    paydayHandleCooldowns
+                        (oldSeedState ^. triggerBlockTime)
+                        (chainParams ^. cpCooldownParameters)
+                        theState4
                 return (theState5, Just paydayParams, newPayday)
             else return (theState0, Nothing, nextPayday)
     -- Update the seed state.
@@ -189,8 +225,9 @@ doEpochTransition True epochDuration theState0 = do
             then do
                 -- This is the start of the last epoch of a payday, so take a baker snapshot.
                 let epochEnd = newSeedState ^. triggerBlockTime
+                let av = accountVersionFor (demoteProtocolVersion (protocolVersion @(MPV m)))
                 (activeBakers, passiveDelegators) <-
-                    applyPendingChanges (<= epochEnd)
+                    applyPendingChanges av (<= epochEnd)
                         <$> bsoGetActiveBakersAndDelegators theState7
                 let BakerStakesAndCapital{..} =
                         computeBakerStakesAndCapital
@@ -203,7 +240,12 @@ doEpochTransition True epochDuration theState0 = do
                         bakerStakes
                         (chainParams ^. cpFinalizationCommitteeParameters)
                 capDist <- capitalDistributionM
-                bsoSetNextCapitalDistribution theState8 capDist
+                theState9 <- bsoSetNextCapitalDistribution theState8 capDist
+                -- From P7 onwards, we transition pre-pre-cooldowns into pre-cooldowns, so that
+                -- at the next payday they will enter cooldown.
+                case sSupportsFlexibleCooldown (sAccountVersionFor (protocolVersion @(MPV m))) of
+                    STrue -> bsoProcessPrePreCooldowns theState9
+                    SFalse -> return theState9
             else return theState7
     return (mPaydayParams, theState9)
 
@@ -237,6 +279,7 @@ executeBlockPrologue ::
     ( pv ~ MPV m,
       BlockStateStorage m,
       BlockState m ~ PBS.HashedPersistentBlockState pv,
+      MonadProtocolVersion m,
       IsConsensusV1 pv
     ) =>
     BlockExecutionData pv ->
diff --git a/concordium-consensus/src/Concordium/Kontrol/Bakers.hs b/concordium-consensus/src/Concordium/Kontrol/Bakers.hs
index 28b986c73..2cc906752 100644
--- a/concordium-consensus/src/Concordium/Kontrol/Bakers.hs
+++ b/concordium-consensus/src/Concordium/Kontrol/Bakers.hs
@@ -81,11 +81,13 @@ delegatedCapitalCap poolParams totalCap bakerCap delCap = min leverageCap boundC
     PoolCaps{..} = delegatedCapitalCaps poolParams totalCap bakerCap delCap
 
 -- | Process a set of bakers and delegators to apply pending changes that are effective.
-applyPendingChanges ::
+-- This is only relevent for protocol versions which support delegation but not flexible cooldowns
+-- (i.e. P4-P6).
+applyPendingChangesP4 ::
     (Timestamp -> Bool) ->
     ([ActiveBakerInfo' bakerInfoRef], [ActiveDelegatorInfo]) ->
     ([ActiveBakerInfo' bakerInfoRef], [ActiveDelegatorInfo])
-applyPendingChanges isEffective (bakers0, passive0) =
+applyPendingChangesP4 isEffective (bakers0, passive0) =
     foldr
         processBaker
         ([], processDelegators passive0)
@@ -124,6 +126,17 @@ applyPendingChanges isEffective (bakers0, passive0) =
       where
         pDelegators = processDelegators activeBakerDelegators
 
+-- | Process a set of bakers and delegators to apply pending changes that are effective.
+applyPendingChanges ::
+    AccountVersion ->
+    (Timestamp -> Bool) ->
+    ([ActiveBakerInfo' bakerInfoRef], [ActiveDelegatorInfo]) ->
+    ([ActiveBakerInfo' bakerInfoRef], [ActiveDelegatorInfo])
+applyPendingChanges av
+    -- If the account version supports flexible cooldowns, there are no pending changes to apply.
+    | supportsFlexibleCooldown av = \_ infos -> infos
+    | otherwise = applyPendingChangesP4
+
 -- | Compute the timestamp of the start of an epoch based on the genesis data.
 epochTimestamp :: GenesisConfiguration -> Epoch -> Timestamp
 epochTimestamp gd targetEpoch =
@@ -200,9 +213,11 @@ computeBakerStakesAndCapital poolParams activeBakers passiveDelegators = BakerSt
 
 -- | Generate and set the next epoch bakers and next capital based on the current active bakers.
 generateNextBakers ::
+    forall m.
     ( TreeStateMonad m,
       PVSupportsDelegation (MPV m),
-      ChainParametersVersionFor (MPV m) ~ 'ChainParametersV1
+      ChainParametersVersionFor (MPV m) ~ 'ChainParametersV1,
+      SupportsFlexibleCooldown (AccountVersionFor (MPV m)) ~ 'False
     ) =>
     -- | The payday epoch
     Epoch ->
@@ -214,7 +229,7 @@ generateNextBakers paydayEpoch bs0 = do
     -- stake reductions that are currently pending on active bakers with effective time at
     -- or before the next payday.
     (activeBakers, passiveDelegators) <-
-        applyPendingChanges isEffective
+        applyPendingChangesP4 isEffective
             <$> bsoGetActiveBakersAndDelegators bs0
     -- Note that we use the current value of the pool parameters as of this block.
     -- This should account for any updates that are effective at or before this block.
@@ -311,9 +326,11 @@ timeParametersAtSlot targetSlot tp0 upds =
 getSlotBakersP4 ::
     forall m.
     ( BlockStateQuery m,
+      MonadProtocolVersion m,
       PVSupportsDelegation (MPV m),
       ChainParametersVersionFor (MPV m) ~ 'ChainParametersV1,
-      SeedStateVersionFor (MPV m) ~ 'SeedStateVersion0
+      SeedStateVersionFor (MPV m) ~ 'SeedStateVersion0,
+      SupportsFlexibleCooldown (AccountVersionFor (MPV m)) ~ 'False
     ) =>
     GenesisConfiguration ->
     BlockState m ->
@@ -364,7 +381,7 @@ getSlotBakersP4 genData bs slot =
                             -- stake reductions that are currently pending on active bakers with effective time at
                             -- or before the next payday.
                             (activeBakers, passiveDelegators) <-
-                                applyPendingChanges isEffective
+                                applyPendingChangesP4 isEffective
                                     <$> getActiveBakersAndDelegators bs
                             -- Determine the pool parameters that would be effective the epoch before the payday
                             pendingPoolParams <- getPendingPoolParameters bs
@@ -391,7 +408,7 @@ getSlotBakersP4 genData bs slot =
 --  The given slot should never be earlier than the slot of the given block.
 getSlotBakers ::
     forall m.
-    ( IsProtocolVersion (MPV m),
+    ( MonadProtocolVersion m,
       BlockStateQuery m,
       ConsensusParametersVersionFor (ChainParametersVersionFor (MPV m)) ~ 'ConsensusParametersVersion0
     ) =>
diff --git a/concordium-consensus/src/Concordium/Scheduler/TreeStateEnvironment.hs b/concordium-consensus/src/Concordium/Scheduler/TreeStateEnvironment.hs
index 6c5403d87..a75f2c99a 100644
--- a/concordium-consensus/src/Concordium/Scheduler/TreeStateEnvironment.hs
+++ b/concordium-consensus/src/Concordium/Scheduler/TreeStateEnvironment.hs
@@ -1087,7 +1087,8 @@ updateBirkParameters newSeedState bs0 oldChainParameters updates = case protocol
     updateCPV1AccountV1 ::
         ( PVSupportsDelegation (MPV m),
           ChainParametersVersionFor (MPV m) ~ 'ChainParametersV1,
-          SeedStateVersionFor (MPV m) ~ 'SeedStateVersion0
+          SeedStateVersionFor (MPV m) ~ 'SeedStateVersion0,
+          SupportsFlexibleCooldown (AccountVersionFor (MPV m)) ~ 'False
         ) =>
         m (MintRewardParams 'ChainParametersV1, UpdatableBlockState m)
     updateCPV1AccountV1 = do
diff --git a/concordium-consensus/tests/globalstate/GlobalStateTests/BlockStateHelpers.hs b/concordium-consensus/tests/globalstate/GlobalStateTests/BlockStateHelpers.hs
new file mode 100644
index 000000000..52fd47ed3
--- /dev/null
+++ b/concordium-consensus/tests/globalstate/GlobalStateTests/BlockStateHelpers.hs
@@ -0,0 +1,197 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+module GlobalStateTests.BlockStateHelpers where
+
+import Control.Exception
+import Control.Monad.IO.Class
+import qualified Data.Map.Strict as Map
+import Data.Maybe
+import qualified Data.Set as Set
+import Lens.Micro
+import System.FilePath
+import System.IO.Temp
+import Test.HUnit
+
+import Concordium.Types
+import Concordium.Types.Accounts
+import Concordium.Types.Execution
+import Concordium.Types.Option
+
+import Concordium.GlobalState.Account
+import qualified Concordium.GlobalState.AccountMap.LMDB as LMDBAccountMap
+import Concordium.GlobalState.CooldownQueue
+import qualified Concordium.GlobalState.DummyData as DummyData
+import Concordium.GlobalState.Persistent.Account
+import qualified Concordium.GlobalState.Persistent.Account.CooldownQueue as CooldownQueue
+import qualified Concordium.GlobalState.Persistent.Account.StructureV1 as SV1
+import Concordium.GlobalState.Persistent.Accounts
+import Concordium.GlobalState.Persistent.BlobStore
+import Concordium.GlobalState.Persistent.BlockState
+import qualified Concordium.GlobalState.Persistent.BlockState.Modules as Modules
+import qualified Concordium.GlobalState.Persistent.Cooldown as Cooldown
+import qualified Concordium.GlobalState.Persistent.ReleaseSchedule as ReleaseSchedule
+import qualified Concordium.GlobalState.Persistent.Trie as Trie
+import Concordium.Scheduler.DummyData
+
+import GlobalStateTests.Accounts (NoLoggerT (..), runNoLoggerT)
+
+-- | Construct a dummy account with the specified cooldowns.
+dummyCooldownAccount ::
+    forall av m.
+    (IsAccountVersion av, MonadBlobStore m, AVSupportsFlexibleCooldown av) =>
+    AccountIndex ->
+    Amount ->
+    Cooldowns ->
+    m (PersistentAccount av)
+dummyCooldownAccount ai amt cooldowns = do
+    makeTestAccountFromSeed @av amt (fromIntegral ai) >>= \case
+        PAV3 acc -> do
+            let ed = SV1.enduringData acc
+            cq <- CooldownQueue.makeCooldownQueue cooldowns
+            newEnduring <- refMake =<< SV1.rehashAccountEnduringData ed{SV1.paedStakeCooldown = cq}
+            return $ PAV3 acc{SV1.accountEnduringData = newEnduring}
+
+data AccountConfig (av :: AccountVersion) = AccountConfig
+    { acAccountIndex :: AccountIndex,
+      acAmount :: Amount,
+      acStaking :: StakeDetails av,
+      acCooldowns :: Cooldowns
+    }
+    deriving (Show)
+
+makePersistentAccountStakeEnduring ::
+    (MonadBlobStore m, AVSupportsFlexibleCooldown av, AVSupportsDelegation av, IsAccountVersion av) =>
+    StakeDetails av ->
+    AccountIndex ->
+    m (SV1.PersistentAccountStakeEnduring av, Amount)
+makePersistentAccountStakeEnduring StakeDetailsNone _ = return (SV1.PersistentAccountStakeEnduringNone, 0)
+makePersistentAccountStakeEnduring StakeDetailsBaker{..} ai = do
+    let fulBaker = DummyData.mkFullBaker (fromIntegral ai) (BakerId ai) ^. _1
+    paseBakerInfo <-
+        refMake
+            BakerInfoExV1
+                { _bieBakerInfo = fulBaker ^. bakerInfo,
+                  _bieBakerPoolInfo = poolInfo
+                }
+    return
+        ( SV1.PersistentAccountStakeEnduringBaker
+            { paseBakerRestakeEarnings = sdRestakeEarnings,
+              paseBakerPendingChange = NoChange,
+              ..
+            },
+          sdStakedCapital
+        )
+  where
+    poolInfo =
+        BakerPoolInfo
+            { _poolOpenStatus = OpenForAll,
+              _poolMetadataUrl = UrlText "Some URL",
+              _poolCommissionRates =
+                CommissionRates
+                    { _finalizationCommission = makeAmountFraction 50_000,
+                      _bakingCommission = makeAmountFraction 50_000,
+                      _transactionCommission = makeAmountFraction 50_000
+                    }
+            }
+makePersistentAccountStakeEnduring StakeDetailsDelegator{..} ai = do
+    return
+        ( SV1.PersistentAccountStakeEnduringDelegator
+            { paseDelegatorId = DelegatorId ai,
+              paseDelegatorRestakeEarnings = sdRestakeEarnings,
+              paseDelegatorTarget = sdDelegationTarget,
+              paseDelegatorPendingChange = NoChange
+            },
+          sdStakedCapital
+        )
+
+-- | Create a dummy 'PersistentAccount' from an 'AccountConfig'.
+makeDummyAccount ::
+    forall av m.
+    ( IsAccountVersion av,
+      MonadBlobStore m,
+      SupportsFlexibleCooldown av ~ 'True
+    ) =>
+    AccountConfig av ->
+    m (PersistentAccount av)
+makeDummyAccount AccountConfig{..} = do
+    makeTestAccountFromSeed @av acAmount (fromIntegral acAccountIndex) >>= \case
+        PAV3 acc -> do
+            let ed = SV1.enduringData acc
+            cq <- CooldownQueue.makeCooldownQueue acCooldowns
+            (staking, stakeAmount) <- makePersistentAccountStakeEnduring acStaking acAccountIndex
+            newEnduring <-
+                refMake
+                    =<< SV1.rehashAccountEnduringData
+                        ed{SV1.paedStakeCooldown = cq, SV1.paedStake = staking}
+            return $
+                PAV3
+                    acc{SV1.accountEnduringData = newEnduring, SV1.accountStakedAmount = stakeAmount}
+
+-- | Run a block state computation using a temporary directory for the blob store and account map.
+runTestBlockState ::
+    forall pv a.
+    PersistentBlockStateMonad
+        pv
+        (PersistentBlockStateContext pv)
+        (BlobStoreT (PersistentBlockStateContext pv) (NoLoggerT IO))
+        a ->
+    IO a
+runTestBlockState kont = withTempDirectory "." "blockstate" $ \dir -> do
+    bracket
+        ( do
+            pbscBlobStore <- createBlobStore (dir </> "blockstate.dat")
+            pbscAccountCache <- newAccountCache 100
+            pbscModuleCache <- Modules.newModuleCache 100
+            pbscAccountMap <- LMDBAccountMap.openDatabase (dir </> "accountmap")
+            return PersistentBlockStateContext{..}
+        )
+        ( \PersistentBlockStateContext{..} -> do
+            closeBlobStore pbscBlobStore
+            LMDBAccountMap.closeDatabase pbscAccountMap
+        )
+        (runNoLoggerT . runBlobStoreT (runPersistentBlockStateMonad kont))
+
+-- | Get the 'Cooldowns' for each account, and check that the indexes for cooldowns, pre-cooldowns
+--  and pre-pre-cooldowns are correct.
+checkCooldowns :: (PVSupportsFlexibleCooldown pv, SupportsPersistentState pv m) => PersistentBlockState pv -> m [Cooldowns]
+checkCooldowns pbs = do
+    bsp <- loadPBS pbs
+    (_, theCooldowns, cooldownMap, preCooldowns, prePreCooldowns) <-
+        foldAccounts
+            ( \(!ai, accum, cooldownMap, preCooldowns, prePreCooldowns) pa -> do
+                cd <- fromMaybe emptyCooldowns <$> accountCooldowns pa
+                let newCooldowns = cd : accum
+                let newCooldownMap = case Map.lookupMin (inCooldown cd) of
+                        Nothing -> cooldownMap
+                        Just (ts, _) ->
+                            Map.alter
+                                ( \case
+                                    Nothing -> Just (Set.singleton ai)
+                                    Just s -> Just (Set.insert ai s)
+                                )
+                                ts
+                                cooldownMap
+                let newPreCooldowns = case preCooldown cd of
+                        Absent -> preCooldowns
+                        Present _ -> Set.insert ai preCooldowns
+                let newPrePreCooldowns = case prePreCooldown cd of
+                        Absent -> prePreCooldowns
+                        Present _ -> Set.insert ai prePreCooldowns
+                return (ai + 1, newCooldowns, newCooldownMap, newPreCooldowns, newPrePreCooldowns)
+            )
+            (AccountIndex 0, [], Map.empty, Set.empty, Set.empty)
+            (bspAccounts bsp)
+    let aic = bspAccountsInCooldown bsp ^. Cooldown.accountsInCooldown
+    actualCooldownMap <- Trie.toMap (ReleaseSchedule.nrsMap $ aic ^. Cooldown.cooldown)
+    liftIO $ assertEqual "Cooldown map" cooldownMap (ReleaseSchedule.theAccountSet <$> actualCooldownMap)
+    actualPreCooldowns <- Set.fromList <$> Cooldown.loadAccountList (aic ^. Cooldown.preCooldown)
+    liftIO $ assertEqual "Pre-cooldown set" preCooldowns actualPreCooldowns
+    actualPrePreCooldowns <- Set.fromList <$> Cooldown.loadAccountList (aic ^. Cooldown.prePreCooldown)
+    liftIO $ assertEqual "Pre-pre-cooldown set" prePreCooldowns actualPrePreCooldowns
+    return (reverse theCooldowns)
diff --git a/concordium-consensus/tests/globalstate/GlobalStateTests/CooldownProcessing.hs b/concordium-consensus/tests/globalstate/GlobalStateTests/CooldownProcessing.hs
new file mode 100644
index 000000000..7c7c7f507
--- /dev/null
+++ b/concordium-consensus/tests/globalstate/GlobalStateTests/CooldownProcessing.hs
@@ -0,0 +1,93 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+-- | This module tests the processing of cooldowns in the global state.
+--  Specifically, it tests the 'bsoProcessPrePreCooldowns' and 'bsoProcessCooldowns' functions.
+module GlobalStateTests.CooldownProcessing where
+
+import Control.Monad.IO.Class
+import Test.HUnit
+import Test.Hspec
+import Test.QuickCheck
+
+import qualified Concordium.Crypto.SHA256 as Hash
+import Concordium.Types
+import Concordium.Types.Option
+import Concordium.Types.SeedState
+
+import Concordium.GlobalState.BlockState
+import Concordium.GlobalState.CooldownQueue
+import qualified Concordium.GlobalState.DummyData as DummyData
+import Concordium.GlobalState.Persistent.BlockState
+
+import GlobalStateTests.Accounts ()
+import GlobalStateTests.BlockStateHelpers
+import GlobalStateTests.CooldownQueue (genCooldowns)
+
+-- | Test 'bsoProcessCooldowns' with a state where the account cooldowns are as given.
+propProcessPrePreCooldowns :: [Cooldowns] -> Assertion
+propProcessPrePreCooldowns cds = runTestBlockState @P7 $ do
+    let mkAcct (i, cd) = dummyCooldownAccount i (cooldownTotal cd + 1000) cd
+    initialAccts <- mapM mkAcct (zip [0 ..] cds)
+    initialBS <-
+        initialPersistentState
+            (initialSeedStateV1 (Hash.hash "NONCE") 1000)
+            DummyData.dummyCryptographicParameters
+            initialAccts
+            DummyData.dummyIdentityProviders
+            DummyData.dummyArs
+            DummyData.dummyKeyCollection
+            DummyData.dummyChainParameters
+    bs' <- bsoProcessPrePreCooldowns (hpbsPointers initialBS)
+    newCooldowns <- checkCooldowns bs'
+    liftIO $ assertEqual "Cooldowns" (processPrePreCooldown <$> cds) newCooldowns
+
+propProcessCooldowns :: [Cooldowns] -> Timestamp -> Timestamp -> Assertion
+propProcessCooldowns cds expire new = runTestBlockState @P7 $ do
+    let mkAcct (i, cd) = dummyCooldownAccount i (cooldownTotal cd + 1000) cd
+    initialAccts <- mapM mkAcct (zip [0 ..] cds)
+    initialBS <-
+        initialPersistentState
+            (initialSeedStateV1 (Hash.hash "NONCE") 1000)
+            DummyData.dummyCryptographicParameters
+            initialAccts
+            DummyData.dummyIdentityProviders
+            DummyData.dummyArs
+            DummyData.dummyKeyCollection
+            DummyData.dummyChainParameters
+    bs' <- bsoProcessCooldowns (hpbsPointers initialBS) expire new
+    newCooldowns <- checkCooldowns bs'
+    liftIO $ assertEqual "Cooldowns" (processPreCooldown new . processCooldowns expire <$> cds) newCooldowns
+
+-- | Generate a 'Cooldowns' with no pre-cooldown.
+genCooldownsNoPre :: Gen Cooldowns
+genCooldownsNoPre = do
+    cooldown <- genCooldowns
+    return cooldown{preCooldown = Absent}
+
+-- | Test 'bsoProcessPrePreCooldowns'.
+testProcessPrePreCooldowns :: Spec
+testProcessPrePreCooldowns = do
+    it "10 accounts, no cooldowns" $ propProcessPrePreCooldowns (replicate 10 emptyCooldowns)
+    it "5 accounts no cooldowns, 5 accounts with pre-pre-cooldown" $
+        propProcessPrePreCooldowns $
+            replicate 5 emptyCooldowns ++ replicate 5 (emptyCooldowns{prePreCooldown = Present 1000})
+    it "accounts with arbitray cooldowns (but no pre-cooldown)" $
+        forAll (listOf genCooldownsNoPre) propProcessPrePreCooldowns
+
+-- | Test 'bsoProcessCooldowns'.
+testProcessCooldowns :: Spec
+testProcessCooldowns = do
+    it "accounts with arbitrary cooldowns" $
+        forAll (listOf genCooldowns) $ \cds -> do
+            forAll arbitrary $ \expire ->
+                forAll arbitrary $ \new ->
+                    propProcessCooldowns cds (Timestamp expire) (Timestamp new)
+
+tests :: Spec
+tests = describe "CooldownProcessing" $ do
+    describe "bsoProcessPrePreCooldowns" testProcessPrePreCooldowns
+    describe "bsoProcessCooldowns" testProcessCooldowns
diff --git a/concordium-consensus/tests/globalstate/Spec.hs b/concordium-consensus/tests/globalstate/Spec.hs
index 11b49943a..ebaec6075 100644
--- a/concordium-consensus/tests/globalstate/Spec.hs
+++ b/concordium-consensus/tests/globalstate/Spec.hs
@@ -10,6 +10,7 @@ import qualified GlobalStateTests.AccountsMigrationP6ToP7 (tests)
 import qualified GlobalStateTests.BlobStore (tests)
 import qualified GlobalStateTests.BlockHash (tests)
 import qualified GlobalStateTests.Cache (tests)
+import qualified GlobalStateTests.CooldownProcessing (tests)
 import qualified GlobalStateTests.CooldownQueue (tests)
 import qualified GlobalStateTests.DifferenceMap (tests)
 import qualified GlobalStateTests.EnduringDataFlags (tests)
@@ -55,3 +56,4 @@ main = atLevel $ \lvl -> hspec $ do
     GlobalStateTests.DifferenceMap.tests
     GlobalStateTests.AccountsMigrationP6ToP7.tests
     GlobalStateTests.CooldownQueue.tests
+    GlobalStateTests.CooldownProcessing.tests
diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/KonsensusV1/EpochTransition.hs b/concordium-consensus/tests/scheduler/SchedulerTests/KonsensusV1/EpochTransition.hs
new file mode 100644
index 000000000..04770ca1a
--- /dev/null
+++ b/concordium-consensus/tests/scheduler/SchedulerTests/KonsensusV1/EpochTransition.hs
@@ -0,0 +1,688 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+module SchedulerTests.KonsensusV1.EpochTransition where
+
+import Control.Exception
+import Control.Monad.IO.Class
+import qualified Data.Map.Strict as Map
+import Data.Maybe
+import qualified Data.Set as Set
+import Lens.Micro
+import System.FilePath
+import System.IO.Temp
+import Test.HUnit
+import Test.Hspec
+import Test.QuickCheck
+
+import qualified Concordium.Crypto.SHA256 as Hash
+import Concordium.Logger
+import Concordium.Types
+import Concordium.Types.Option
+import Concordium.Types.SeedState
+
+import Concordium.GlobalState.Account
+import qualified Concordium.GlobalState.AccountMap.LMDB as LMDBAccountMap
+import Concordium.GlobalState.BakerInfo
+import Concordium.GlobalState.BlockState
+import Concordium.GlobalState.CooldownQueue
+import qualified Concordium.GlobalState.DummyData as DummyData
+import Concordium.GlobalState.Persistent.Account
+import qualified Concordium.GlobalState.Persistent.Account.CooldownQueue as CooldownQueue
+import qualified Concordium.GlobalState.Persistent.Account.StructureV1 as SV1
+import Concordium.GlobalState.Persistent.Accounts
+import Concordium.GlobalState.Persistent.BlobStore
+import Concordium.GlobalState.Persistent.BlockState
+import qualified Concordium.GlobalState.Persistent.BlockState.Modules as Modules
+import qualified Concordium.GlobalState.Persistent.Cooldown as Cooldown
+import qualified Concordium.GlobalState.Persistent.ReleaseSchedule as ReleaseSchedule
+import qualified Concordium.GlobalState.Persistent.Trie as Trie
+import Concordium.GlobalState.Types
+import Concordium.KonsensusV1.Scheduler
+import Concordium.Kontrol.Bakers
+import Concordium.Scheduler.DummyData
+import Concordium.Types.Accounts
+import Concordium.Types.Execution
+import Concordium.Types.Parameters
+import Control.Monad
+import qualified Data.Vector as Vec
+
+dummyCooldownAccount ::
+    forall av m.
+    (IsAccountVersion av, MonadBlobStore m, AVSupportsFlexibleCooldown av) =>
+    AccountIndex ->
+    Amount ->
+    Cooldowns ->
+    m (PersistentAccount av)
+dummyCooldownAccount ai amt cooldowns = do
+    makeTestAccountFromSeed @av amt (fromIntegral ai) >>= \case
+        PAV3 acc -> do
+            let ed = SV1.enduringData acc
+            cq <- CooldownQueue.makeCooldownQueue cooldowns
+            newEnduring <- refMake =<< SV1.rehashAccountEnduringData ed{SV1.paedStakeCooldown = cq}
+            return $ PAV3 acc{SV1.accountEnduringData = newEnduring}
+
+runTestBlockState ::
+    forall pv a.
+    PersistentBlockStateMonad
+        pv
+        (PersistentBlockStateContext pv)
+        (BlobStoreT (PersistentBlockStateContext pv) (LoggerT IO))
+        a ->
+    IO a
+runTestBlockState kont = withTempDirectory "." "blockstate" $ \dir -> do
+    bracket
+        ( do
+            pbscBlobStore <- createBlobStore (dir </> "blockstate.dat")
+            pbscAccountCache <- newAccountCache 100
+            pbscModuleCache <- Modules.newModuleCache 100
+            pbscAccountMap <- LMDBAccountMap.openDatabase (dir </> "accountmap")
+            return PersistentBlockStateContext{..}
+        )
+        ( \PersistentBlockStateContext{..} -> do
+            closeBlobStore pbscBlobStore
+            LMDBAccountMap.closeDatabase pbscAccountMap
+        )
+        (runSilentLogger . runBlobStoreT (runPersistentBlockStateMonad kont))
+
+-- | Get the 'Cooldowns' for each account, and check that the indexes for cooldowns, pre-cooldowns
+--  and pre-pre-cooldowns are correct.
+checkCooldowns :: (PVSupportsFlexibleCooldown pv, SupportsPersistentState pv m) => PersistentBlockState pv -> m [Cooldowns]
+checkCooldowns pbs = do
+    bsp <- loadPBS pbs
+    (_, theCooldowns, cooldownMap, preCooldowns, prePreCooldowns) <-
+        foldAccounts
+            ( \(!ai, accum, cooldownMap, preCooldowns, prePreCooldowns) pa -> do
+                cd <- fromMaybe emptyCooldowns <$> accountCooldowns pa
+                let newCooldowns = cd : accum
+                let newCooldownMap = case Map.lookupMin (inCooldown cd) of
+                        Nothing -> cooldownMap
+                        Just (ts, _) ->
+                            Map.alter
+                                ( \case
+                                    Nothing -> Just (Set.singleton ai)
+                                    Just s -> Just (Set.insert ai s)
+                                )
+                                ts
+                                cooldownMap
+                let newPreCooldowns = case preCooldown cd of
+                        Absent -> preCooldowns
+                        Present _ -> Set.insert ai preCooldowns
+                let newPrePreCooldowns = case prePreCooldown cd of
+                        Absent -> prePreCooldowns
+                        Present _ -> Set.insert ai prePreCooldowns
+                return (ai + 1, newCooldowns, newCooldownMap, newPreCooldowns, newPrePreCooldowns)
+            )
+            (AccountIndex 0, [], Map.empty, Set.empty, Set.empty)
+            (bspAccounts bsp)
+    let aic = bspAccountsInCooldown bsp ^. Cooldown.accountsInCooldown
+    actualCooldownMap <- Trie.toMap (ReleaseSchedule.nrsMap $ aic ^. Cooldown.cooldown)
+    liftIO $ assertEqual "Cooldown map" cooldownMap (ReleaseSchedule.theAccountSet <$> actualCooldownMap)
+    actualPreCooldowns <- Set.fromList <$> Cooldown.loadAccountList (aic ^. Cooldown.preCooldown)
+    liftIO $ assertEqual "Pre-cooldown set" preCooldowns actualPreCooldowns
+    actualPrePreCooldowns <- Set.fromList <$> Cooldown.loadAccountList (aic ^. Cooldown.prePreCooldown)
+    liftIO $ assertEqual "Pre-pre-cooldown set" prePreCooldowns actualPrePreCooldowns
+    return (reverse theCooldowns)
+
+data AccountConfig (av :: AccountVersion) = AccountConfig
+    { acAccountIndex :: AccountIndex,
+      acAmount :: Amount,
+      acInitialStaking :: StakeDetails av,
+      acUpdatedStaking :: StakeDetails av,
+      acCooldowns :: Cooldowns
+    }
+    deriving (Show)
+
+-- | Generate a list of 'AccountConfig's such that:
+--
+--    * The initial staking includes at least one baker, and there are no delegators to invalid bakers.
+--    * The updated staking includes at least one baker, and there are no delegators to invalid bakers.
+--    * The amounts on the account are consistent with the active and inactive stake.
+--    * The cooldowns only include pre-cooldowns if the 'allowPreCooldown' flag is set.
+genAccountConfigs :: (AVSupportsDelegation av) => Bool -> Gen [AccountConfig av]
+genAccountConfigs allowPreCooldown = sized $ \n -> do
+    let accs = [AccountIndex 0 .. fromIntegral (max 0 n)]
+    let chooseBakers = do
+            bkrs <- sublistOf accs
+            if null bkrs
+                then (: []) <$> elements accs
+                else return bkrs
+    initBakers <- chooseBakers
+    updBakers <- chooseBakers
+    let genBakerStakeDetails sdStakedCapital = do
+            sdRestakeEarnings <- arbitrary
+            let sdPendingChange = NoChange
+            return StakeDetailsBaker{..}
+        genDelegatorStakeDetails sdStakedCapital bakers = do
+            sdRestakeEarnings <- arbitrary
+            sdDelegationTarget <-
+                oneof
+                    [ pure DelegatePassive,
+                      DelegateToBaker . BakerId <$> elements bakers
+                    ]
+            let sdPendingChange = NoChange
+            return StakeDetailsDelegator{..}
+        genCooldowns = do
+            inCooldown <- Map.fromList <$> listOf (((,) . Timestamp <$> arbitrary) <*> arbitrary)
+            preCooldown <-
+                if allowPreCooldown
+                    then oneof [return Absent, Present <$> arbitrary]
+                    else return Absent
+            prePreCooldown <- oneof [return Absent, Present <$> arbitrary]
+            return Cooldowns{..}
+        genAcc acAccountIndex = do
+            initStakeAmount <- Amount <$> choose (1_000_000, 1_000_000_000)
+            acInitialStaking <-
+                if acAccountIndex `elem` initBakers
+                    then genBakerStakeDetails initStakeAmount
+                    else
+                        oneof
+                            [ genDelegatorStakeDetails initStakeAmount initBakers,
+                              pure StakeDetailsNone
+                            ]
+            updatedStakeAmount <- Amount <$> choose (1_000_000, 1_000_000_000)
+            acUpdatedStaking <-
+                if acAccountIndex `elem` updBakers
+                    then genBakerStakeDetails updatedStakeAmount
+                    else
+                        oneof
+                            [ genDelegatorStakeDetails updatedStakeAmount updBakers,
+                              pure StakeDetailsNone
+                            ]
+            acCooldowns <- genCooldowns
+            bonusAmount <- Amount <$> choose (0, 1_000_000_000)
+            let acAmount = cooldownTotal acCooldowns + updatedStakeAmount + bonusAmount
+            return AccountConfig{..}
+    mapM genAcc accs
+
+makePersistentAccountStakeEnduring ::
+    (MonadBlobStore m, AVSupportsFlexibleCooldown av, AVSupportsDelegation av, IsAccountVersion av) =>
+    StakeDetails av ->
+    AccountIndex ->
+    m (SV1.PersistentAccountStakeEnduring av, Amount)
+makePersistentAccountStakeEnduring StakeDetailsNone _ = return (SV1.PersistentAccountStakeEnduringNone, 0)
+makePersistentAccountStakeEnduring StakeDetailsBaker{..} ai = do
+    let (fulBaker, _, _, _) = DummyData.mkFullBaker (fromIntegral ai) (BakerId ai)
+    paseBakerInfo <-
+        refMake
+            BakerInfoExV1
+                { _bieBakerInfo = fulBaker ^. bakerInfo,
+                  _bieBakerPoolInfo = poolInfo
+                }
+    return
+        ( SV1.PersistentAccountStakeEnduringBaker
+            { paseBakerRestakeEarnings = sdRestakeEarnings,
+              paseBakerPendingChange = NoChange,
+              ..
+            },
+          sdStakedCapital
+        )
+  where
+    poolInfo =
+        BakerPoolInfo
+            { _poolOpenStatus = OpenForAll,
+              _poolMetadataUrl = UrlText "Some URL",
+              _poolCommissionRates =
+                CommissionRates
+                    { _finalizationCommission = makeAmountFraction 50_000,
+                      _bakingCommission = makeAmountFraction 50_000,
+                      _transactionCommission = makeAmountFraction 50_000
+                    }
+            }
+makePersistentAccountStakeEnduring StakeDetailsDelegator{..} ai = do
+    return
+        ( SV1.PersistentAccountStakeEnduringDelegator
+            { paseDelegatorId = DelegatorId ai,
+              paseDelegatorRestakeEarnings = sdRestakeEarnings,
+              paseDelegatorTarget = sdDelegationTarget,
+              paseDelegatorPendingChange = NoChange
+            },
+          sdStakedCapital
+        )
+
+-- | Create a dummy 'PersistentAccount' from an 'AccountConfig'.
+makeDummyAccount ::
+    forall av m.
+    ( IsAccountVersion av,
+      MonadBlobStore m,
+      AVSupportsFlexibleCooldown av,
+      AVSupportsDelegation av
+    ) =>
+    AccountConfig av ->
+    m (PersistentAccount av)
+makeDummyAccount AccountConfig{..} = do
+    makeTestAccountFromSeed @av acAmount (fromIntegral acAccountIndex) >>= \case
+        PAV3 acc -> do
+            let ed = SV1.enduringData acc
+            cq <- CooldownQueue.makeCooldownQueue acCooldowns
+            (staking, stakeAmount) <- makePersistentAccountStakeEnduring acInitialStaking acAccountIndex
+            newEnduring <-
+                refMake
+                    =<< SV1.rehashAccountEnduringData
+                        ed{SV1.paedStakeCooldown = cq, SV1.paedStake = staking}
+            return $
+                PAV3
+                    acc{SV1.accountEnduringData = newEnduring, SV1.accountStakedAmount = stakeAmount}
+
+-- | Construct an initial state for testing based on the account configuration provided.
+makeInitialState ::
+    forall pv m.
+    ( SupportsPersistentState pv m,
+      PVSupportsFlexibleCooldown pv,
+      IsConsensusV1 pv,
+      BlockStateOperations m,
+      UpdatableBlockState m ~ PersistentBlockState pv,
+      IsSupported 'PTTimeParameters (ChainParametersVersionFor pv) ~ 'True
+    ) =>
+    -- | Initial configuration of accounts.
+    [AccountConfig (AccountVersionFor pv)] ->
+    -- | Initial seed state.
+    SeedState (SeedStateVersionFor pv) ->
+    -- | Length of the reward period.
+    RewardPeriodLength ->
+    m (PersistentBlockState pv)
+makeInitialState accs seedState rpLen = withIsAuthorizationsVersionForPV (protocolVersion @pv) $ do
+    initialAccounts <- mapM makeDummyAccount accs
+    let chainParams :: ChainParameters pv
+        chainParams = DummyData.dummyChainParameters & cpTimeParameters . tpRewardPeriodLength .~ rpLen
+    initialBS <-
+        initialPersistentState
+            seedState
+            DummyData.dummyCryptographicParameters
+            initialAccounts
+            DummyData.dummyIdentityProviders
+            DummyData.dummyArs
+            DummyData.dummyKeyCollection
+            chainParams
+    let pbs0 = hpbsPointers initialBS
+    (activeBakers, passiveDelegators) <- bsoGetActiveBakersAndDelegators pbs0
+    let BakerStakesAndCapital{..} = computeBakerStakesAndCapital (chainParams ^. cpPoolParameters) activeBakers passiveDelegators
+    pbs1 <- bsoSetNextEpochBakers pbs0 bakerStakes (chainParams ^. cpFinalizationCommitteeParameters)
+    capDist <- capitalDistributionM
+    pbs2 <- bsoSetNextCapitalDistribution pbs1 capDist
+    pbs <- bsoRotateCurrentCapitalDistribution =<< bsoRotateCurrentEpochBakers pbs2
+
+    bsp <- loadPBS pbs
+    -- Now we update the accounts with the updated staking information.
+    let
+        updateAccountStake ::
+            AccountConfig (AccountVersionFor pv) ->
+            PersistentAccount (AccountVersionFor pv) ->
+            m (PersistentAccount (AccountVersionFor pv))
+        updateAccountStake AccountConfig{..} (PAV3 pa) = do
+            (staking, newStakeAmount) <- makePersistentAccountStakeEnduring acUpdatedStaking acAccountIndex
+            let ed = SV1.enduringData pa
+            newEnduring <- refMake =<< SV1.rehashAccountEnduringData ed{SV1.paedStake = staking}
+            return $ PAV3 pa{SV1.accountEnduringData = newEnduring, SV1.accountStakedAmount = newStakeAmount}
+    newAccounts <-
+        foldM
+            (\a ac -> updateAccountsAtIndex' (updateAccountStake ac) (acAccountIndex ac) a)
+            (bspAccounts bsp)
+            accs
+    accts <- foldAccountsDesc (\l acc -> return (acc : l)) [] newAccounts
+    newBirkParameters <- initialBirkParameters accts seedState (chainParams ^. cpFinalizationCommitteeParameters)
+    storePBS pbs bsp{bspAccounts = newAccounts, bspBirkParameters = newBirkParameters}
+
+transitionalSeedState :: Epoch -> Timestamp -> SeedState SeedStateVersion1
+transitionalSeedState curEpoch triggerTime =
+    (initialSeedStateV1 (Hash.hash "NONCE") triggerTime)
+        { ss1Epoch = curEpoch,
+          ss1EpochTransitionTriggered = True
+        }
+
+-- | Test an epoch transition with no payday or snapshot.
+testEpochTransitionNoPaydayNoSnapshot :: [AccountConfig 'AccountV3] -> Assertion
+testEpochTransitionNoPaydayNoSnapshot accountConfigs = runTestBlockState @P7 $ do
+    bs0 <- makeInitialState accountConfigs (transitionalSeedState startEpoch startTriggerTime) 2
+    initCapDist <- bsoGetCurrentCapitalDistribution bs0
+    initBakers <- bsoGetCurrentEpochFullBakersEx bs0
+    bs1 <- bsoSetPaydayEpoch bs0 (startEpoch + 10)
+    (mPaydayParams, resState) <- doEpochTransition True hour bs1
+    liftIO $ assertEqual "Payday parameters" Nothing mPaydayParams
+    newCooldowns <- checkCooldowns resState
+    liftIO $ assertEqual "Cooldowns should be unchanged" (map acCooldowns accountConfigs) newCooldowns
+    ss <- bsoGetSeedState resState
+    case ss of
+        SeedStateV1{..} -> liftIO $ do
+            assertEqual "Epoch should be updated" (startEpoch + 1) ss1Epoch
+            assertEqual
+                "Trigger time should be updated"
+                (addDuration startTriggerTime hour)
+                ss1TriggerBlockTime
+            assertEqual
+                "Epoch transition should no longer be triggered"
+                False
+                ss1EpochTransitionTriggered
+    finalCapDist <- bsoGetCurrentCapitalDistribution resState
+    liftIO $ assertEqual "Capital distribution should be unchanged" initCapDist finalCapDist
+    finalBakers <- bsoGetCurrentEpochFullBakersEx resState
+    liftIO $ assertEqual "Bakers should be unchanged" initBakers finalBakers
+    updBakers <- bsoRotateCurrentCapitalDistribution =<< bsoRotateCurrentEpochBakers resState
+    finalNECapDist <- bsoGetCurrentCapitalDistribution updBakers
+    liftIO $ assertEqual "Next-epoch capital distribution should be unchanged" initCapDist finalNECapDist
+    finalNEBakers <- bsoGetCurrentEpochFullBakersEx updBakers
+    liftIO $ assertEqual "Next-epoch bakers should be unchanged" initBakers finalNEBakers
+  where
+    hour = Duration 3_600_000
+    startEpoch = 10
+    startTriggerTime = 1000
+
+-- | Test a payday epoch transition.
+testEpochTransitionPaydayOnly :: [AccountConfig 'AccountV3] -> Assertion
+testEpochTransitionPaydayOnly accountConfigs = runTestBlockState @P7 $ do
+    bs0 <- makeInitialState accountConfigs (transitionalSeedState startEpoch startTriggerTime) 2
+    initCapDist <- bsoGetCurrentCapitalDistribution bs0
+    initBakers <- bsoGetCurrentEpochFullBakersEx bs0
+    bs1 <- bsoSetPaydayEpoch bs0 (startEpoch + 1)
+    (mPaydayParams, resState) <- doEpochTransition True hour bs1
+    liftIO $ case mPaydayParams of
+        Just PaydayParameters{..} -> do
+            assertEqual "Payday capital distribution" initCapDist paydayCapitalDistribution
+            assertEqual "Payday bakers" initBakers paydayBakers
+        Nothing -> do
+            assertFailure "Expected payday parameters"
+    newCooldowns <- checkCooldowns resState
+    let processCooldownAtPayday =
+            processPreCooldown (startTriggerTime `addDurationSeconds` cooldownDuration)
+                . processCooldowns startTriggerTime
+    liftIO $
+        assertEqual
+            "Expired cooldowns should be processed and pre-cooldowns should be moved to cooldowns"
+            (map (processCooldownAtPayday . acCooldowns) accountConfigs)
+            newCooldowns
+    ss <- bsoGetSeedState resState
+    case ss of
+        SeedStateV1{..} -> liftIO $ do
+            assertEqual "Epoch should be updated" (startEpoch + 1) ss1Epoch
+            assertEqual
+                "Trigger time should be updated"
+                (addDuration startTriggerTime hour)
+                ss1TriggerBlockTime
+            assertEqual
+                "Epoch transition should no longer be triggered"
+                False
+                ss1EpochTransitionTriggered
+    finalCapDist <- bsoGetCurrentCapitalDistribution resState
+    liftIO $ assertEqual "Capital distribution should be unchanged" initCapDist finalCapDist
+    finalBakers <- bsoGetCurrentEpochFullBakersEx resState
+    liftIO $ assertEqual "Bakers should be unchanged" initBakers finalBakers
+    updBakers <- bsoRotateCurrentCapitalDistribution =<< bsoRotateCurrentEpochBakers resState
+    finalNECapDist <- bsoGetCurrentCapitalDistribution updBakers
+    liftIO $ assertEqual "Next-epoch capital distribution should be unchanged" initCapDist finalNECapDist
+    finalNEBakers <- bsoGetCurrentEpochFullBakersEx updBakers
+    liftIO $ assertEqual "Next-epoch bakers should be unchanged" initBakers finalNEBakers
+  where
+    hour = Duration 3_600_000
+    startEpoch = 10
+    startTriggerTime = 1000
+    cooldownDuration =
+        DummyData.dummyChainParameters @ChainParametersV2
+            ^. cpCooldownParameters . cpUnifiedCooldown
+
+-- | Test an snapshot epoch transition.
+testEpochTransitionSnapshotOnly :: [AccountConfig 'AccountV3] -> Assertion
+testEpochTransitionSnapshotOnly accountConfigs = runTestBlockState @P7 $ do
+    bs0 <- makeInitialState accountConfigs (transitionalSeedState startEpoch startTriggerTime) 2
+    initCapDist <- bsoGetCurrentCapitalDistribution bs0
+    initBakers <- bsoGetCurrentEpochFullBakersEx bs0
+    bs1 <- bsoSetPaydayEpoch bs0 (startEpoch + 2)
+    (activeBakers, activeDelegators) <- bsoGetActiveBakersAndDelegators bs1
+    let BakerStakesAndCapital{..} =
+            computeBakerStakesAndCapital
+                (chainParams ^. cpPoolParameters)
+                activeBakers
+                activeDelegators
+    updatedCapitalDistr <- capitalDistributionM
+    let mkFullBaker (ref, stake) = do
+            loadPersistentBakerInfoRef @_ @'AccountV3 ref <&> \case
+                (BakerInfoExV1 info extra) ->
+                    FullBakerInfoEx
+                        { _exFullBakerInfo = FullBakerInfo info stake,
+                          _bakerPoolCommissionRates = extra ^. poolCommissionRates
+                        }
+    bkrs <- mapM mkFullBaker bakerStakes
+    let updatedBakerStakes = FullBakersEx (Vec.fromList bkrs) (sum $ snd <$> bakerStakes)
+
+    (mPaydayParams, resState) <- doEpochTransition True hour bs1
+    liftIO $ assertEqual "Payday parameters" Nothing mPaydayParams
+    newCooldowns <- checkCooldowns resState
+    liftIO $
+        assertEqual
+            "Expired cooldowns should be processed and pre-cooldowns should be moved to cooldowns"
+            (map (processPrePreCooldown . acCooldowns) accountConfigs)
+            newCooldowns
+    ss <- bsoGetSeedState resState
+    case ss of
+        SeedStateV1{..} -> liftIO $ do
+            assertEqual "Epoch should be updated" (startEpoch + 1) ss1Epoch
+            assertEqual
+                "Trigger time should be updated"
+                (addDuration startTriggerTime hour)
+                ss1TriggerBlockTime
+            assertEqual
+                "Epoch transition should no longer be triggered"
+                False
+                ss1EpochTransitionTriggered
+    finalCapDist <- bsoGetCurrentCapitalDistribution resState
+    liftIO $ assertEqual "Capital distribution should be unchanged" initCapDist finalCapDist
+    finalBakers <- bsoGetCurrentEpochFullBakersEx resState
+    liftIO $ assertEqual "Bakers should be unchanged" initBakers finalBakers
+    updBakers <- bsoRotateCurrentCapitalDistribution =<< bsoRotateCurrentEpochBakers resState
+    finalNECapDist <- bsoGetCurrentCapitalDistribution updBakers
+    liftIO $ assertEqual "Next-epoch capital distribution should be updated" updatedCapitalDistr finalNECapDist
+    finalNEBakers <- bsoGetCurrentEpochFullBakersEx updBakers
+    liftIO $ assertEqual "Next-epoch bakers should be updated" updatedBakerStakes finalNEBakers
+  where
+    hour = Duration 3_600_000
+    startEpoch = 10
+    startTriggerTime = 1000
+    chainParams = DummyData.dummyChainParameters @ChainParametersV2
+
+-- | Test two successive epoch transitions where the first is a snapshot and the second is a payday.
+testEpochTransitionSnapshotPayday :: [AccountConfig 'AccountV3] -> Assertion
+testEpochTransitionSnapshotPayday accountConfigs = runTestBlockState @P7 $ do
+    bs0 <- makeInitialState accountConfigs (transitionalSeedState startEpoch startTriggerTime) 2
+    initCapDist <- bsoGetCurrentCapitalDistribution bs0
+    initBakers <- bsoGetCurrentEpochFullBakersEx bs0
+    bs1 <- bsoSetPaydayEpoch bs0 (startEpoch + 2)
+    (activeBakers, activeDelegators) <- bsoGetActiveBakersAndDelegators bs1
+    let BakerStakesAndCapital{..} =
+            computeBakerStakesAndCapital
+                (chainParams ^. cpPoolParameters)
+                activeBakers
+                activeDelegators
+    updatedCapitalDistr <- capitalDistributionM
+    let mkFullBaker (ref, stake) = do
+            loadPersistentBakerInfoRef @_ @'AccountV3 ref <&> \case
+                (BakerInfoExV1 info extra) ->
+                    FullBakerInfoEx
+                        { _exFullBakerInfo = FullBakerInfo info stake,
+                          _bakerPoolCommissionRates = extra ^. poolCommissionRates
+                        }
+    bkrs <- mapM mkFullBaker bakerStakes
+    let updatedBakerStakes = FullBakersEx (Vec.fromList bkrs) (sum $ snd <$> bakerStakes)
+
+    (mPaydayParams, snapshotState) <- doEpochTransition True hour bs1
+    liftIO $ assertEqual "Payday parameters" Nothing mPaydayParams
+    newCooldowns <- checkCooldowns snapshotState
+    let expectCooldowns1 = processPrePreCooldown . acCooldowns <$> accountConfigs
+    liftIO $
+        assertEqual
+            "Pre-pre-cooldowns should be moved to pre-cooldown"
+            expectCooldowns1
+            newCooldowns
+    ss <- bsoGetSeedState snapshotState
+    case ss of
+        SeedStateV1{..} -> liftIO $ do
+            assertEqual "Epoch should be updated" (startEpoch + 1) ss1Epoch
+            assertEqual
+                "Trigger time should be updated"
+                (addDuration startTriggerTime hour)
+                ss1TriggerBlockTime
+            assertEqual
+                "Epoch transition should no longer be triggered"
+                False
+                ss1EpochTransitionTriggered
+    snapshotCapDist <- bsoGetCurrentCapitalDistribution snapshotState
+    liftIO $ assertEqual "Capital distribution should be unchanged" initCapDist snapshotCapDist
+    snapshotBakers <- bsoGetCurrentEpochFullBakersEx snapshotState
+    liftIO $ assertEqual "Bakers should be unchanged" initBakers snapshotBakers
+
+    (mPaydayParams', resState) <- doEpochTransition True hour snapshotState
+    liftIO $ case mPaydayParams' of
+        Just PaydayParameters{..} -> do
+            assertEqual "Payday capital distribution" initCapDist paydayCapitalDistribution
+            assertEqual "Payday bakers" initBakers paydayBakers
+        Nothing -> do
+            assertFailure "Expected payday parameters"
+    newCooldowns' <- checkCooldowns resState
+    let paydayTime = startTriggerTime `addDuration` hour
+    let processCooldownAtPayday =
+            processPreCooldown (paydayTime `addDurationSeconds` cooldownDuration)
+                . processCooldowns paydayTime
+    let expectCooldowns2 = processCooldownAtPayday <$> expectCooldowns1
+    liftIO $
+        assertEqual
+            "Expired cooldowns should be processed and pre-cooldowns should be moved to cooldowns"
+            expectCooldowns2
+            newCooldowns'
+    finalCapDist <- bsoGetCurrentCapitalDistribution resState
+    liftIO $ assertEqual "Capital distribution should be updated" updatedCapitalDistr finalCapDist
+    finalBakers <- bsoGetCurrentEpochFullBakersEx resState
+    liftIO $ assertEqual "Bakers should be updated" updatedBakerStakes finalBakers
+
+    updBakers <- bsoRotateCurrentCapitalDistribution =<< bsoRotateCurrentEpochBakers resState
+    finalNECapDist <- bsoGetCurrentCapitalDistribution updBakers
+    liftIO $ assertEqual "Next-epoch capital distribution should be updated" updatedCapitalDistr finalNECapDist
+    finalNEBakers <- bsoGetCurrentEpochFullBakersEx updBakers
+    liftIO $ assertEqual "Next-epoch bakers should be updated" updatedBakerStakes finalNEBakers
+  where
+    hour = Duration 3_600_000
+    startEpoch = 10
+    startTriggerTime = 1000
+    chainParams = DummyData.dummyChainParameters @ChainParametersV2
+    cooldownDuration = chainParams ^. cpCooldownParameters . cpUnifiedCooldown
+
+-- | Test epoch transitions for two successive transitions where the payday length is one epoch.
+-- In this case, both the snapshot and payday processing occur on each transition, so this tests
+-- that they are correctly ordered.
+testEpochTransitionSnapshotPaydayCombo :: [AccountConfig 'AccountV3] -> Assertion
+testEpochTransitionSnapshotPaydayCombo accountConfigs = runTestBlockState @P7 $ do
+    -- Setup the initial state.
+    bs0 <- makeInitialState accountConfigs (transitionalSeedState startEpoch startTriggerTime) 1
+    initCapDist <- bsoGetCurrentCapitalDistribution bs0
+    initBakers <- bsoGetCurrentEpochFullBakersEx bs0
+    bs1 <- bsoSetPaydayEpoch bs0 (startEpoch + 1)
+    (activeBakers, activeDelegators) <- bsoGetActiveBakersAndDelegators bs1
+    let BakerStakesAndCapital{..} =
+            computeBakerStakesAndCapital
+                (chainParams ^. cpPoolParameters)
+                activeBakers
+                activeDelegators
+    updatedCapitalDistr <- capitalDistributionM
+    let mkFullBaker (ref, stake) = do
+            loadPersistentBakerInfoRef @_ @'AccountV3 ref <&> \case
+                (BakerInfoExV1 info extra) ->
+                    FullBakerInfoEx
+                        { _exFullBakerInfo = FullBakerInfo info stake,
+                          _bakerPoolCommissionRates = extra ^. poolCommissionRates
+                        }
+    bkrs <- mapM mkFullBaker bakerStakes
+    let updatedBakerStakes = FullBakersEx (Vec.fromList bkrs) (sum $ snd <$> bakerStakes)
+
+    -- First epoch transition.
+    (mPaydayParams, snapshotState) <- doEpochTransition True hour bs1
+    liftIO $ case mPaydayParams of
+        Just PaydayParameters{..} -> do
+            assertEqual "Payday capital distribution (1)" initCapDist paydayCapitalDistribution
+            assertEqual "Payday bakers (1)" initBakers paydayBakers
+        Nothing -> do
+            assertFailure "Expected payday parameters (1)"
+    newCooldowns1 <- checkCooldowns snapshotState
+    let processPaydayCooldowns paydayTime =
+            processPrePreCooldown
+                . processPreCooldown (paydayTime `addDurationSeconds` cooldownDuration)
+                . processCooldowns paydayTime
+    let expectedCooldowns1 = processPaydayCooldowns startTriggerTime . acCooldowns <$> accountConfigs
+    liftIO $
+        assertEqual
+            "Cooldowns should be processed at payday (1)"
+            expectedCooldowns1
+            newCooldowns1
+    ss <- bsoGetSeedState snapshotState
+    case ss of
+        SeedStateV1{..} -> liftIO $ do
+            assertEqual "Epoch should be updated (1)" (startEpoch + 1) ss1Epoch
+            assertEqual
+                "Trigger time should be updated (1)"
+                (addDuration startTriggerTime hour)
+                ss1TriggerBlockTime
+            assertEqual
+                "Epoch transition should no longer be triggered (1)"
+                False
+                ss1EpochTransitionTriggered
+    snapshotCapDist <- bsoGetCurrentCapitalDistribution snapshotState
+    liftIO $ assertEqual "Capital distribution should be unchanged (1)" initCapDist snapshotCapDist
+    snapshotBakers <- bsoGetCurrentEpochFullBakersEx snapshotState
+    liftIO $ assertEqual "Bakers should be unchanged (1)" initBakers snapshotBakers
+
+    -- Second epoch transition.
+    let payday2Time = startTriggerTime `addDuration` hour
+    (mPaydayParams', resState) <- doEpochTransition True hour snapshotState
+    liftIO $ case mPaydayParams' of
+        Just PaydayParameters{..} -> do
+            assertEqual "Payday capital distribution" initCapDist paydayCapitalDistribution
+            assertEqual "Payday bakers" initBakers paydayBakers
+        Nothing -> do
+            assertFailure "Expected payday parameters"
+    newCooldowns2 <- checkCooldowns snapshotState
+    let expectedCooldowns2 = processPaydayCooldowns payday2Time <$> expectedCooldowns1
+    liftIO $
+        assertEqual
+            "Cooldowns should be processed at payday (2)"
+            expectedCooldowns2
+            newCooldowns2
+    bsoGetSeedState snapshotState >>= \case
+        SeedStateV1{..} -> liftIO $ do
+            assertEqual "Epoch should be updated (2)" (startEpoch + 2) ss1Epoch
+            assertEqual
+                "Trigger time should be updated (2)"
+                (addDuration payday2Time hour)
+                ss1TriggerBlockTime
+            assertEqual
+                "Epoch transition should no longer be triggered (2)"
+                False
+                ss1EpochTransitionTriggered
+    finalCapDist <- bsoGetCurrentCapitalDistribution resState
+    liftIO $ assertEqual "Capital distribution should be updated (2)" updatedCapitalDistr finalCapDist
+    finalBakers <- bsoGetCurrentEpochFullBakersEx resState
+    liftIO $ assertEqual "Bakers should be updated (2)" updatedBakerStakes finalBakers
+    updBakers <- bsoRotateCurrentCapitalDistribution =<< bsoRotateCurrentEpochBakers resState
+    finalNECapDist <- bsoGetCurrentCapitalDistribution updBakers
+    liftIO $ assertEqual "Next-epoch capital distribution should be updated (2)" updatedCapitalDistr finalNECapDist
+    finalNEBakers <- bsoGetCurrentEpochFullBakersEx updBakers
+    liftIO $ assertEqual "Next-epoch bakers should be updated (2)" updatedBakerStakes finalNEBakers
+  where
+    hour = Duration 3_600_000
+    startEpoch = 10
+    startTriggerTime = 1000
+    chainParams = DummyData.dummyChainParameters @ChainParametersV2
+    cooldownDuration = chainParams ^. cpCooldownParameters . cpUnifiedCooldown
+
+tests :: Spec
+tests = parallel $ describe "EpochTransition" $ do
+    it "testEpochTransitionNoPaydayNoSnapshot" $
+        forAll (genAccountConfigs True) testEpochTransitionNoPaydayNoSnapshot
+    it "testEpochTransitionPaydayOnly" $
+        forAll (genAccountConfigs True) testEpochTransitionPaydayOnly
+    it "testEpochTransitionSnapshotOnly" $
+        forAll (genAccountConfigs False) testEpochTransitionSnapshotOnly
+    it "testEpochTransitionSnapshotPayday" $
+        forAll (genAccountConfigs False) testEpochTransitionSnapshotPayday
+    it "testEpochTransitionSnapshotPaydayCombo" $
+        forAll (genAccountConfigs False) testEpochTransitionSnapshotPaydayCombo
diff --git a/concordium-consensus/tests/scheduler/Spec.hs b/concordium-consensus/tests/scheduler/Spec.hs
index 54c8d97c0..db6979f1d 100644
--- a/concordium-consensus/tests/scheduler/Spec.hs
+++ b/concordium-consensus/tests/scheduler/Spec.hs
@@ -52,6 +52,8 @@ import qualified SchedulerTests.SmartContracts.V1.Upgrading (tests)
 import qualified SchedulerTests.SmartContracts.V1.UpgradingPersistent (tests)
 import qualified SchedulerTests.SmartContracts.V1.ValidInvalidModules (tests)
 
+import qualified SchedulerTests.KonsensusV1.EpochTransition (tests)
+
 import Test.Hspec
 
 main :: IO ()
@@ -105,3 +107,4 @@ main = hspec $ do
     SchedulerTests.SmartContracts.V1.CustomSectionSize.tests
     SchedulerTests.SmartContracts.V1.AccountSignatureChecks.tests
     SchedulerTests.SmartContracts.V1.InspectModuleReferenceAndContractName.tests
+    SchedulerTests.KonsensusV1.EpochTransition.tests

From 57bae020d8432b59fea17a3404d24d46b7fabb72 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Mon, 5 Aug 2024 14:54:35 +0200
Subject: [PATCH 53/81] Documentation

---
 .../GlobalState/Persistent/BlockState.hs      | 20 +++++++++++++++++++
 .../GlobalStateTests/BlockStateHelpers.hs     |  7 +++++++
 .../KonsensusV1/EpochTransition.hs            | 14 ++++++++++++-
 3 files changed, 40 insertions(+), 1 deletion(-)

diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
index 8f6d4a5ec..b463c28ea 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
@@ -3391,30 +3391,48 @@ doProcessCooldowns pbs now newExpiry = do
               bspAccounts = newAccts
             }
   where
+    -- Perform a monadic update on the global cooldown release schedule.
     withCooldown a = (_1 . cooldown .=) =<< a =<< use (_1 . cooldown)
+    -- Perform a monadic update an the accounts table.
     withAccounts a = (_2 .=) =<< a =<< use _2
     process = do
+        -- Determine which accounts have cooldowns that have expired and remove them from the
+        -- cooldown schedule.
         cooldown0 <- use (_1 . cooldown)
         (cooldownList, cooldown1) <- processReleasesUntil now cooldown0
         _1 . cooldown .= cooldown1
+        -- Process the cooldowns for the accounts that have expired cooldowns, adding them back
+        -- to the cooldown schedule if they have remaining cooldowns.
         forM_ cooldownList $ \acc -> do
             withAccounts (Accounts.updateAccountsAtIndex' (processCooldownForAccount acc) acc)
+        -- Fetch and clear the list of accounts in pre-cooldown.
         preCooldownAL <- _1 . preCooldown <<.= Null
         preCooldowns <- loadAccountList preCooldownAL
+        -- Process the pre-cooldowns, moving them into cooldown.
         forM_ preCooldowns $ \acc -> do
             withAccounts (Accounts.updateAccountsAtIndex' (processPreCooldownForAccount acc) acc)
     processCooldownForAccount acc pa = do
+        -- Release the elapsed cooldowns on the account.
         (mNextCooldown, newPA) <- processAccountCooldownsUntil now pa
+        -- If there are remaining cooldowns, add the account back to the cooldown schedule.
         forM_ mNextCooldown $ \nextCooldown -> withCooldown $ addAccountRelease nextCooldown acc
         return newPA
     processPreCooldownForAccount acc pa = do
+        -- Process the pre-cooldowns on the account.
         (res, newPA) <- processAccountPreCooldown newExpiry pa
         case res of
+            -- In this case, the account already had cooldowns, but the new cooldown expires
+            -- earlier, so the release schedule needs to be updated.
             Just (Just oldTS) -> withCooldown $ updateAccountRelease oldTS newExpiry acc
+            -- In this case, the account did not have cooldowns, so the new cooldown is added.
             Just Nothing -> withCooldown $ addAccountRelease newExpiry acc
+            -- In this case, the earliest cooldown on the account has not changed.
             Nothing -> return ()
         return newPA
 
+-- | Move all pre-pre-cooldowns into pre-cooldown.
+--
+-- PRECONDITION: there are no pre-cooldowns.
 doProcessPrePreCooldowns ::
     forall pv m.
     (SupportsPersistentState pv m, PVSupportsFlexibleCooldown pv) =>
@@ -3423,12 +3441,14 @@ doProcessPrePreCooldowns ::
 doProcessPrePreCooldowns pbs = do
     bsp <- loadPBS pbs
     let oldAIC = bspAccountsInCooldown bsp ^. accountsInCooldown
+    -- The new pre-cooldown list is the old pre-pre-cooldown list.
     let !newPreCooldown = assert (isNull (oldAIC ^. preCooldown)) $ oldAIC ^. prePreCooldown
     let newAIC =
             oldAIC
                 & preCooldown .~ newPreCooldown
                 & prePreCooldown .~ Null
     accounts <- loadAccountList newPreCooldown
+    -- Process the pre-pre-cooldown on each account, moving it to pre-cooldown.
     let processAccount = flip $ Accounts.updateAccountsAtIndex' processAccountPrePreCooldown
     newAccts <- foldM processAccount (bspAccounts bsp) accounts
     storePBS pbs $
diff --git a/concordium-consensus/tests/globalstate/GlobalStateTests/BlockStateHelpers.hs b/concordium-consensus/tests/globalstate/GlobalStateTests/BlockStateHelpers.hs
index 52fd47ed3..3b728e096 100644
--- a/concordium-consensus/tests/globalstate/GlobalStateTests/BlockStateHelpers.hs
+++ b/concordium-consensus/tests/globalstate/GlobalStateTests/BlockStateHelpers.hs
@@ -6,6 +6,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 
+-- | Common functions for testing operations on the block state.
 module GlobalStateTests.BlockStateHelpers where
 
 import Control.Exception
@@ -57,6 +58,8 @@ dummyCooldownAccount ai amt cooldowns = do
             newEnduring <- refMake =<< SV1.rehashAccountEnduringData ed{SV1.paedStakeCooldown = cq}
             return $ PAV3 acc{SV1.accountEnduringData = newEnduring}
 
+-- | A configuration for an account, specifying the account index, amount, staking details and
+--  cooldowns. This is used to create accounts for testing.
 data AccountConfig (av :: AccountVersion) = AccountConfig
     { acAccountIndex :: AccountIndex,
       acAmount :: Amount,
@@ -65,10 +68,14 @@ data AccountConfig (av :: AccountVersion) = AccountConfig
     }
     deriving (Show)
 
+-- | Helper function for creating the initial stake for an account.
 makePersistentAccountStakeEnduring ::
     (MonadBlobStore m, AVSupportsFlexibleCooldown av, AVSupportsDelegation av, IsAccountVersion av) =>
+    -- | The 'StakeDetails' for the account.
     StakeDetails av ->
+    -- | The account index.
     AccountIndex ->
+    -- | The 'SV1.PersistentAccountStakeEnduring' and the amount staked.
     m (SV1.PersistentAccountStakeEnduring av, Amount)
 makePersistentAccountStakeEnduring StakeDetailsNone _ = return (SV1.PersistentAccountStakeEnduringNone, 0)
 makePersistentAccountStakeEnduring StakeDetailsBaker{..} ai = do
diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/KonsensusV1/EpochTransition.hs b/concordium-consensus/tests/scheduler/SchedulerTests/KonsensusV1/EpochTransition.hs
index 04770ca1a..09b54923d 100644
--- a/concordium-consensus/tests/scheduler/SchedulerTests/KonsensusV1/EpochTransition.hs
+++ b/concordium-consensus/tests/scheduler/SchedulerTests/KonsensusV1/EpochTransition.hs
@@ -6,6 +6,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 
+-- | Tests for the epoch transition logic for protocol version 7.
 module SchedulerTests.KonsensusV1.EpochTransition where
 
 import Control.Exception
@@ -52,6 +53,7 @@ import Concordium.Types.Parameters
 import Control.Monad
 import qualified Data.Vector as Vec
 
+-- | Create a 'PersistentAccount' with the given index, amount and cooldowns.
 dummyCooldownAccount ::
     forall av m.
     (IsAccountVersion av, MonadBlobStore m, AVSupportsFlexibleCooldown av) =>
@@ -67,6 +69,7 @@ dummyCooldownAccount ai amt cooldowns = do
             newEnduring <- refMake =<< SV1.rehashAccountEnduringData ed{SV1.paedStakeCooldown = cq}
             return $ PAV3 acc{SV1.accountEnduringData = newEnduring}
 
+-- | Run a test block state computation with a temporary directory for the block state.
 runTestBlockState ::
     forall pv a.
     PersistentBlockStateMonad
@@ -129,11 +132,17 @@ checkCooldowns pbs = do
     liftIO $ assertEqual "Pre-pre-cooldown set" prePreCooldowns actualPrePreCooldowns
     return (reverse theCooldowns)
 
+-- | Account configuration for testing.
 data AccountConfig (av :: AccountVersion) = AccountConfig
-    { acAccountIndex :: AccountIndex,
+    { -- | The account index
+      acAccountIndex :: AccountIndex,
+      -- | The account balance
       acAmount :: Amount,
+      -- | Determines the initial (current epoch) stake distribution.
       acInitialStaking :: StakeDetails av,
+      -- | Determines the active stake distribution.
       acUpdatedStaking :: StakeDetails av,
+      -- | Cooldowns on the account.
       acCooldowns :: Cooldowns
     }
     deriving (Show)
@@ -200,6 +209,7 @@ genAccountConfigs allowPreCooldown = sized $ \n -> do
             return AccountConfig{..}
     mapM genAcc accs
 
+-- | Helper for constructing the stake for a persistent account.
 makePersistentAccountStakeEnduring ::
     (MonadBlobStore m, AVSupportsFlexibleCooldown av, AVSupportsDelegation av, IsAccountVersion av) =>
     StakeDetails av ->
@@ -328,6 +338,8 @@ makeInitialState accs seedState rpLen = withIsAuthorizationsVersionForPV (protoc
     newBirkParameters <- initialBirkParameters accts seedState (chainParams ^. cpFinalizationCommitteeParameters)
     storePBS pbs bsp{bspAccounts = newAccounts, bspBirkParameters = newBirkParameters}
 
+-- | A seed state with the specified epoch an trigger time, in which the epoch transition has been
+--  triggered.
 transitionalSeedState :: Epoch -> Timestamp -> SeedState SeedStateVersion1
 transitionalSeedState curEpoch triggerTime =
     (initialSeedStateV1 (Hash.hash "NONCE") triggerTime)

From 6d5f08c3b1de3d759a6baf2b81eb3cf5a7327977 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Thu, 8 Aug 2024 15:40:56 +0200
Subject: [PATCH 54/81] Tests for bsoAddValidator and bsoUpdateValidator.
 Bugfixes.

---
 .../GlobalState/Persistent/BlockState.hs      |  40 +-
 .../GlobalStateTests/BlockStateHelpers.hs     |  99 ++-
 .../GlobalStateTests/ConfigureValidator.hs    | 623 ++++++++++++++++++
 .../tests/globalstate/Spec.hs                 |   2 +
 4 files changed, 700 insertions(+), 64 deletions(-)
 create mode 100644 concordium-consensus/tests/globalstate/GlobalStateTests/ConfigureValidator.hs

diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
index bd1123808..e2bd67289 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
@@ -306,7 +306,7 @@ initialBirkParameters accounts seedState _bakerFinalizationCommitteeParameters =
                   _passiveDelegators = ibpcdToPassive,
                   _totalActiveCapital = case delegationSupport @av of
                     SAVDelegationNotSupported -> TotalActiveCapitalV0
-                    SAVDelegationSupported -> TotalActiveCapitalV1 aibpTotal
+                    SAVDelegationSupported -> TotalActiveCapitalV1 aibpStakedTotal
                 }
 
     nextEpochBakers <- do
@@ -1760,7 +1760,9 @@ updateValidatorChecks bsp baker ValidatorUpdate{..} = do
 --           the current baker cooldown period according to the chain parameters
 --
 --           - (>= P7) transfer the existing staked capital to pre-pre-cooldown, and mark the
---           account as in pre-pre-cooldown (in the global index) if it wasn't already
+--           account as in pre-pre-cooldown (in the global index) if it wasn't already, and
+--           update the active bakers index to reflect the change, including removing the baker's
+--           aggregation key from the in-use set
 --
 --           - append @BakerConfigureStakeReduced 0@ to @events@;
 --
@@ -1772,8 +1774,9 @@ updateValidatorChecks bsp baker ValidatorUpdate{..} = do
 --             @bcuSlotTimestamp@ plus the current baker cooldown period according to the chain
 --             parameters
 --
---           - (>= P7) transfer the decrease in staked capital to pre-pre-cooldown, and mark the
---             account as in pre-pre-cooldown (in the global index) if it wasn't already
+--           - (>= P7) transfer the decrease in staked capital to pre-pre-cooldown, mark the
+--             account as in pre-pre-cooldown (in the global index) if it wasn't already, and
+--             update the active bakers index to reflect the change
 --
 --           - append @BakerConfigureStakeReduced capital@ to @events@;
 --
@@ -1926,7 +1929,12 @@ newUpdateValidator pbs curTimestamp ai vu@ValidatorUpdate{..} = do
                 MTL.tell [BakerConfigureStakeReduced 0]
                 alreadyInPrePreCooldown <- accountHasPrePreCooldown acc
                 acc1 <- removeAccountStake acc >>= addAccountPrePreCooldown oldCapital
-                bsp1 <- moveDelegatorsToPassive bsp (Just oldCapital)
+                let oldKeys =
+                        maybe
+                            (oldBaker ^. BaseAccounts.bakerAggregationVerifyKey)
+                            bkuAggregationKey
+                            vuKeys
+                bsp1 <- moveDelegatorsToPassive bsp (Just (oldCapital, oldKeys))
                 bsp2 <- (if alreadyInPrePreCooldown then return else addToPrePreCooldowns) bsp1
                 return (bsp2, acc1)
             else case compare capital oldCapital of
@@ -1955,16 +1963,22 @@ newUpdateValidator pbs curTimestamp ai vu@ValidatorUpdate{..} = do
                     let bsp2 = bsp1{bspAccountsInCooldown = newAIC}
                     return (bsp2, acc1)
     -- Move all @bid@'s current delegators into passive delegation.
-    -- If the amount (the baker's prior stake) is specified, then @bid@ is removed from the active
-    -- bakers, and the total active capital is reduced accordingly.
-    moveDelegatorsToPassive bsp mAmount = do
+    -- If the amount (the baker's prior stake) and key (the bakers prior aggregation key) are
+    -- specified, then @bid@ is removed from the active bakers, the total active capital is reduced
+    -- accordingly, and the aggregation key is removed from the set of keys in use.
+    moveDelegatorsToPassive bsp mAmountAndKey = do
         pab0 <- refLoad (bspBirkParameters bsp ^. birkActiveBakers)
         (delegators, pab1) <- transferDelegatorsToPassive bid pab0
-        pab2 <- case mAmount of
+        pab2 <- case mAmountAndKey of
             Nothing -> return pab1
-            Just amount -> do
-                newTrie <- Trie.delete bid (pab1 ^. activeBakers)
-                return $ pab1 & totalActiveCapital %~ subtractActiveCapital amount & activeBakers .~ newTrie
+            Just (amount, aggKey) -> do
+                newActiveBakers <- Trie.delete bid (pab1 ^. activeBakers)
+                newAggregationKeys <- Trie.delete aggKey (pab1 ^. aggregationKeys)
+                return $
+                    pab1
+                        & totalActiveCapital %~ subtractActiveCapital amount
+                        & activeBakers .~ newActiveBakers
+                        & aggregationKeys .~ newAggregationKeys
         newPABref <- refMake pab2
         let newBirkParams = bspBirkParameters bsp & birkActiveBakers .~ newPABref
         newAccounts <- foldM redelegatePassive (bspAccounts bsp) delegators
@@ -2052,7 +2066,7 @@ addDelegatorChecks bsp DelegatorAdd{daDelegationTarget = Transactions.DelegateTo
   where
     BakerId baid = bid
 
--- \| From chain parameters version >= 1, this operation is used to add a delegator.
+-- | From chain parameters version >= 1, this operation is used to add a delegator.
 --  When adding delegator, it is assumed that 'AccountIndex' account is NOT a baker and NOT a delegator.
 --
 --  PRECONDITIONS:
diff --git a/concordium-consensus/tests/globalstate/GlobalStateTests/BlockStateHelpers.hs b/concordium-consensus/tests/globalstate/GlobalStateTests/BlockStateHelpers.hs
index 3b728e096..f9efac15f 100644
--- a/concordium-consensus/tests/globalstate/GlobalStateTests/BlockStateHelpers.hs
+++ b/concordium-consensus/tests/globalstate/GlobalStateTests/BlockStateHelpers.hs
@@ -11,6 +11,7 @@ module GlobalStateTests.BlockStateHelpers where
 
 import Control.Exception
 import Control.Monad.IO.Class
+import Data.Bool.Singletons
 import qualified Data.Map.Strict as Map
 import Data.Maybe
 import qualified Data.Set as Set
@@ -68,77 +69,73 @@ data AccountConfig (av :: AccountVersion) = AccountConfig
     }
     deriving (Show)
 
--- | Helper function for creating the initial stake for an account.
-makePersistentAccountStakeEnduring ::
-    (MonadBlobStore m, AVSupportsFlexibleCooldown av, AVSupportsDelegation av, IsAccountVersion av) =>
-    -- | The 'StakeDetails' for the account.
-    StakeDetails av ->
-    -- | The account index.
+-- | Set the staking details for an account.
+setAccountStakeDetails ::
+    (MonadBlobStore m, AVSupportsDelegation av, IsAccountVersion av) =>
     AccountIndex ->
-    -- | The 'SV1.PersistentAccountStakeEnduring' and the amount staked.
-    m (SV1.PersistentAccountStakeEnduring av, Amount)
-makePersistentAccountStakeEnduring StakeDetailsNone _ = return (SV1.PersistentAccountStakeEnduringNone, 0)
-makePersistentAccountStakeEnduring StakeDetailsBaker{..} ai = do
-    let fulBaker = DummyData.mkFullBaker (fromIntegral ai) (BakerId ai) ^. _1
-    paseBakerInfo <-
-        refMake
-            BakerInfoExV1
-                { _bieBakerInfo = fulBaker ^. bakerInfo,
-                  _bieBakerPoolInfo = poolInfo
-                }
-    return
-        ( SV1.PersistentAccountStakeEnduringBaker
-            { paseBakerRestakeEarnings = sdRestakeEarnings,
-              paseBakerPendingChange = NoChange,
-              ..
-            },
-          sdStakedCapital
-        )
+    StakeDetails av ->
+    PersistentAccount av ->
+    m (PersistentAccount av)
+setAccountStakeDetails _ StakeDetailsNone acc = return acc
+setAccountStakeDetails ai StakeDetailsBaker{..} acc =
+    setAccountStakePendingChange sdPendingChange
+        =<< addAccountBakerV1 bie sdStakedCapital sdRestakeEarnings acc
   where
+    bie =
+        BakerInfoExV1
+            { _bieBakerInfo = fulBaker ^. bakerInfo,
+              _bieBakerPoolInfo = poolInfo
+            }
+    fulBaker = DummyData.mkFullBaker (fromIntegral ai) (BakerId ai) ^. _1
     poolInfo =
         BakerPoolInfo
             { _poolOpenStatus = OpenForAll,
               _poolMetadataUrl = UrlText "Some URL",
               _poolCommissionRates =
+                -- Note: these commission rates are significant for the ConfigureValidator tests
                 CommissionRates
-                    { _finalizationCommission = makeAmountFraction 50_000,
-                      _bakingCommission = makeAmountFraction 50_000,
-                      _transactionCommission = makeAmountFraction 50_000
+                    { _finalizationCommission = makeAmountFraction 350,
+                      _bakingCommission = makeAmountFraction 550,
+                      _transactionCommission = makeAmountFraction 150
                     }
             }
-makePersistentAccountStakeEnduring StakeDetailsDelegator{..} ai = do
-    return
-        ( SV1.PersistentAccountStakeEnduringDelegator
-            { paseDelegatorId = DelegatorId ai,
-              paseDelegatorRestakeEarnings = sdRestakeEarnings,
-              paseDelegatorTarget = sdDelegationTarget,
-              paseDelegatorPendingChange = NoChange
-            },
-          sdStakedCapital
-        )
+setAccountStakeDetails ai StakeDetailsDelegator{..} acc =
+    setAccountStakePendingChange sdPendingChange =<< addAccountDelegator del acc
+  where
+    del =
+        AccountDelegationV1
+            { _delegationTarget = sdDelegationTarget,
+              _delegationStakedAmount = sdStakedCapital,
+              _delegationStakeEarnings = sdRestakeEarnings,
+              _delegationPendingChange = NoChange,
+              _delegationIdentity = DelegatorId ai
+            }
 
 -- | Create a dummy 'PersistentAccount' from an 'AccountConfig'.
 makeDummyAccount ::
     forall av m.
     ( IsAccountVersion av,
       MonadBlobStore m,
-      SupportsFlexibleCooldown av ~ 'True
+      SupportsDelegation av ~ 'True
     ) =>
     AccountConfig av ->
     m (PersistentAccount av)
 makeDummyAccount AccountConfig{..} = do
-    makeTestAccountFromSeed @av acAmount (fromIntegral acAccountIndex) >>= \case
-        PAV3 acc -> do
-            let ed = SV1.enduringData acc
-            cq <- CooldownQueue.makeCooldownQueue acCooldowns
-            (staking, stakeAmount) <- makePersistentAccountStakeEnduring acStaking acAccountIndex
-            newEnduring <-
-                refMake
-                    =<< SV1.rehashAccountEnduringData
-                        ed{SV1.paedStakeCooldown = cq, SV1.paedStake = staking}
-            return $
-                PAV3
-                    acc{SV1.accountEnduringData = newEnduring, SV1.accountStakedAmount = stakeAmount}
+    acc0 <- makeTestAccountFromSeed @av acAmount (fromIntegral acAccountIndex)
+    acc1 <- setAccountStakeDetails acAccountIndex acStaking acc0
+    case sSupportsFlexibleCooldown (accountVersion @av) of
+        STrue -> case acc1 of
+            PAV3 acc -> do
+                let ed = SV1.enduringData acc
+                cq <- CooldownQueue.makeCooldownQueue acCooldowns
+                newEnduring <-
+                    refMake
+                        =<< SV1.rehashAccountEnduringData
+                            ed{SV1.paedStakeCooldown = cq}
+                return $
+                    PAV3
+                        acc{SV1.accountEnduringData = newEnduring}
+        SFalse -> return acc1
 
 -- | Run a block state computation using a temporary directory for the blob store and account map.
 runTestBlockState ::
diff --git a/concordium-consensus/tests/globalstate/GlobalStateTests/ConfigureValidator.hs b/concordium-consensus/tests/globalstate/GlobalStateTests/ConfigureValidator.hs
new file mode 100644
index 000000000..28fea3804
--- /dev/null
+++ b/concordium-consensus/tests/globalstate/GlobalStateTests/ConfigureValidator.hs
@@ -0,0 +1,623 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+module GlobalStateTests.ConfigureValidator where
+
+import Control.Monad
+import Control.Monad.IO.Class
+import Control.Monad.Writer.CPS
+import Data.Bool.Singletons
+import qualified Data.Map.Strict as Map
+import Data.Maybe
+import Lens.Micro.Platform
+import Test.Hspec
+import Test.QuickCheck
+
+import qualified Concordium.Crypto.BlockSignature as Sig
+import qualified Concordium.Crypto.BlsSignature as Bls
+import qualified Concordium.Crypto.SHA256 as Hash
+import qualified Concordium.Crypto.VRF as VRF
+import Concordium.Types
+import Concordium.Types.Accounts
+import qualified Concordium.Types.DummyData as DummyData
+import Concordium.Types.Execution
+import Concordium.Types.Option
+import Concordium.Types.Parameters
+import Concordium.Types.SeedState
+
+import Concordium.GlobalState.Account
+import Concordium.GlobalState.BakerInfo
+import Concordium.GlobalState.BlockState
+import Concordium.GlobalState.CooldownQueue
+import qualified Concordium.GlobalState.DummyData as DummyData
+import qualified Concordium.GlobalState.Persistent.Accounts as Accounts
+import Concordium.GlobalState.Persistent.Bakers
+import Concordium.GlobalState.Persistent.BlobStore
+import Concordium.GlobalState.Persistent.BlockState
+import qualified Concordium.GlobalState.Persistent.Trie as Trie
+
+import GlobalStateTests.BlockStateHelpers
+
+-- | Representation of the active bakers in the block state.
+data ActiveBakers = ActiveBakers
+    { abActiveBakers :: Map.Map BakerId ([DelegatorId], Amount),
+      abAggregationKeys :: [BakerAggregationVerifyKey],
+      abPassiveDelegators :: ([DelegatorId], Amount),
+      abTotalActiveCapital :: Amount
+    }
+    deriving (Eq, Show)
+
+-- | Load the active bakers from the block state.
+-- Note, 'abTotalActiveCapital' will be 0 if the block state is from a version that does not store
+-- this value.
+loadActiveBakers :: forall av m. (MonadBlobStore m, IsAccountVersion av) => BufferedRef (PersistentActiveBakers av) -> m ActiveBakers
+loadActiveBakers pabRef = do
+    PersistentActiveBakers{..} <- refLoad pabRef
+    bakers0 <- Trie.toMap _activeBakers
+    abActiveBakers <- mapM loadActiveDelegators bakers0
+    abAggregationKeys <- Map.keys <$> Trie.toMap _aggregationKeys
+    abPassiveDelegators <- loadActiveDelegators _passiveDelegators
+    let abTotalActiveCapital = case _totalActiveCapital of
+            TotalActiveCapitalV0 -> 0
+            TotalActiveCapitalV1 capital -> capital
+    return ActiveBakers{..}
+  where
+    loadActiveDelegators :: PersistentActiveDelegators av -> m ([DelegatorId], Amount)
+    loadActiveDelegators PersistentActiveDelegatorsV0 = return ([], 0)
+    loadActiveDelegators (PersistentActiveDelegatorsV1 delegators capital) = do
+        dlgs <- Trie.keysAsc delegators
+        return (dlgs, capital)
+
+-- | Test accounts used for testing the 'bsoAddValidator' function.
+--  The first account is a regular account, the second account is a baker account.
+addValidatorTestAccounts ::
+    -- | Whether the first account should have cooldowns.
+    Bool ->
+    [AccountConfig pv]
+addValidatorTestAccounts withCooldowns =
+    [ AccountConfig
+        { acAccountIndex = 0,
+          acAmount = 1_000_000_000_000,
+          acStaking = StakeDetailsNone,
+          acCooldowns = if withCooldowns then initialTestCooldowns else emptyCooldowns
+        },
+      AccountConfig
+        { acAccountIndex = 1,
+          acAmount = 1_000_000_000_000,
+          acStaking =
+            StakeDetailsBaker
+                { sdStakedCapital = 500_000_000_000,
+                  sdRestakeEarnings = True,
+                  sdPendingChange = NoChange
+                },
+          acCooldowns = emptyCooldowns
+        }
+    ]
+
+-- | Conditions that can trigger a specific error in 'bsoAddValidator' or 'bsoUpdateValidator'.
+data ValidatorConditions = ValidatorConditions
+    { vcUnderThreshold :: Bool,
+      vcTransactionFeeNotInRange :: Bool,
+      vcBakingRewardNotInRange :: Bool,
+      vcFinalizationRewardNotInRange :: Bool,
+      vcAggregationKeyDuplicate :: Bool
+    }
+    deriving (Show)
+
+-- | All possible 'ValidatorConditions' configurations.
+validatorConditions :: [ValidatorConditions]
+validatorConditions = do
+    vcUnderThreshold <- [True, False]
+    vcTransactionFeeNotInRange <- [True, False]
+    vcBakingRewardNotInRange <- [True, False]
+    vcFinalizationRewardNotInRange <- [True, False]
+    vcAggregationKeyDuplicate <- [True, False]
+    return ValidatorConditions{..}
+
+-- | Derive a 'BakerKeyUpdate' from a seed.
+makeBakerKeyUpdate :: Int -> BakerKeyUpdate
+makeBakerKeyUpdate seed =
+    BakerKeyUpdate
+        { bkuSignKey = Sig.verifyKey $ DummyData.bakerSignKey seed,
+          bkuAggregationKey = Bls.derivePublicKey $ DummyData.bakerAggregationKey seed,
+          bkuElectionKey = VRF.publicKey $ DummyData.bakerElectionKey seed
+        }
+
+-- | Test 'bsoAddValidator' in a variety of cases that exercise the different error conditions,
+--   and ensure that the behaviour is as expected (including on success).
+testAddValidatorAllCases ::
+    forall pv.
+    ( IsProtocolVersion pv,
+      SupportsDelegation (AccountVersionFor pv) ~ 'True,
+      PoolParametersVersionFor (ChainParametersVersionFor pv) ~ 'PoolParametersVersion1
+    ) =>
+    SProtocolVersion pv ->
+    Spec
+testAddValidatorAllCases spv = describe "bsoAddValidator" $ do
+    forM_ validatorConditions $ \vc -> do
+        it (show vc) $ runTest False vc
+        when supportCooldown $ it (show vc <> " with cooldown") $ runTest True vc
+  where
+    supportCooldown = supportsFlexibleCooldown $ accountVersionFor $ demoteProtocolVersion (protocolVersion @pv)
+    seedState :: SeedState (SeedStateVersionFor pv)
+    seedState = case sSeedStateVersionFor (protocolVersion @pv) of
+        SSeedStateVersion0 -> initialSeedStateV0 (Hash.hash "NONCE") 1000
+        SSeedStateVersion1 -> initialSeedStateV1 (Hash.hash "NONCE") 1000
+    minEquity = 1_000_000_000
+    chainParams =
+        DummyData.dummyChainParameters @(ChainParametersVersionFor pv)
+            & cpPoolParameters . ppMinimumEquityCapital .~ minEquity
+            & cpPoolParameters . ppCommissionBounds
+                .~ CommissionRanges
+                    { _transactionCommissionRange = InclusiveRange (makeAmountFraction 100) (makeAmountFraction 200),
+                      _finalizationCommissionRange = InclusiveRange (makeAmountFraction 300) (makeAmountFraction 400),
+                      _bakingCommissionRange = InclusiveRange (makeAmountFraction 500) (makeAmountFraction 600)
+                    }
+    mkInitialState accounts =
+        hpbsPointers
+            <$> initialPersistentState @pv
+                seedState
+                DummyData.dummyCryptographicParameters
+                accounts
+                DummyData.dummyIdentityProviders
+                DummyData.dummyArs
+                (withIsAuthorizationsVersionForPV spv DummyData.dummyKeyCollection)
+                chainParams
+    runTest withCooldown ValidatorConditions{..} = runTestBlockState @pv $ do
+        let va =
+                ValidatorAdd
+                    { vaKeys = if vcAggregationKeyDuplicate then badKeys else goodKeys,
+                      vaCapital = if vcUnderThreshold then minEquity - 1 else minEquity,
+                      vaRestakeEarnings = True,
+                      vaOpenForDelegation = OpenForAll,
+                      vaMetadataURL = UrlText "Some URL",
+                      vaCommissionRates =
+                        CommissionRates
+                            { _finalizationCommission = makeAmountFraction $ if vcFinalizationRewardNotInRange then 100 else 300,
+                              _bakingCommission = makeAmountFraction $ if vcBakingRewardNotInRange then 100 else 500,
+                              _transactionCommission = makeAmountFraction $ if vcTransactionFeeNotInRange then 300 else 100
+                            }
+                    }
+        initialAccounts <- mapM makeDummyAccount (addValidatorTestAccounts withCooldown)
+        initialBS <- mkInitialState initialAccounts
+        res <- bsoAddValidator initialBS 0 va
+        let expect
+                | vcUnderThreshold = Left VCFStakeUnderThreshold
+                | vcTransactionFeeNotInRange = Left VCFTransactionFeeCommissionNotInRange
+                | vcBakingRewardNotInRange = Left VCFBakingRewardCommissionNotInRange
+                | vcFinalizationRewardNotInRange = Left VCFFinalizationRewardCommissionNotInRange
+                | vcAggregationKeyDuplicate = Left (VCFDuplicateAggregationKey (bkuAggregationKey (vaKeys va)))
+                | otherwise = Right ()
+        liftIO $ void res `shouldBe` expect
+        forM_ res $ \bs -> do
+            -- To check that the active stake indexes are updated correctly, we construct a new
+            -- block state using the current state of the accounts (which will build the indexes
+            -- anew) and check that the indexes match.
+            bsp <- loadPBS bs
+            theAccounts <- Accounts.foldAccountsDesc (\l a -> pure (a : l)) [] (bspAccounts bsp)
+            newBSP <- loadPBS =<< mkInitialState theAccounts
+            expectedActiveBakers <- loadActiveBakers (_birkActiveBakers $ bspBirkParameters newBSP)
+            actualActiveBakers <- loadActiveBakers (_birkActiveBakers $ bspBirkParameters bsp)
+            liftIO $ actualActiveBakers `shouldBe` expectedActiveBakers
+            () <- case sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv)) of
+                STrue -> do
+                    -- Check that the cooldowns are correct
+                    newCooldowns <- checkCooldowns bs
+                    let bakerInitialCooldowns
+                            | withCooldown = initialTestCooldowns
+                            | otherwise = emptyCooldowns
+                    let bakerExpectedCooldowns = reactivateCooldownAmount (vaCapital va) bakerInitialCooldowns
+                    liftIO $ newCooldowns `shouldBe` [bakerExpectedCooldowns, emptyCooldowns]
+                SFalse -> return ()
+            acc <- bsoGetAccountByIndex bs 0
+            let expectedBaker =
+                    AccountBaker
+                        { _stakedAmount = vaCapital va,
+                          _stakeEarnings = vaRestakeEarnings va,
+                          _bakerPendingChange = NoChange,
+                          _accountBakerInfo =
+                            BakerInfoExV1
+                                { _bieBakerInfo =
+                                    BakerInfo
+                                        { _bakerSignatureVerifyKey = bkuSignKey (vaKeys va),
+                                          _bakerElectionVerifyKey = bkuElectionKey (vaKeys va),
+                                          _bakerAggregationVerifyKey = bkuAggregationKey (vaKeys va),
+                                          _bakerIdentity = BakerId 0
+                                        },
+                                  _bieBakerPoolInfo =
+                                    BakerPoolInfo
+                                        { _poolOpenStatus = vaOpenForDelegation va,
+                                          _poolMetadataUrl = vaMetadataURL va,
+                                          _poolCommissionRates = vaCommissionRates va
+                                        }
+                                }
+                        }
+            bkr <- getAccountBaker (fromJust acc)
+            liftIO $ bkr `shouldBe` Just expectedBaker
+            return ()
+    goodKeys = makeBakerKeyUpdate 0
+    badKeys = makeBakerKeyUpdate 1
+
+-- | The initial stake amount for the test accounts.
+initialStakedAmount :: Amount
+initialStakedAmount = 500_000_000_000
+
+-- | Some non-trivial cooldowns that may be set on an account for testing.
+initialTestCooldowns :: Cooldowns
+initialTestCooldowns =
+    Cooldowns
+        { inCooldown = Map.fromList [(1000, 100_000_000_000), (2000, 100_000_000_000)],
+          prePreCooldown = Present 2000,
+          preCooldown = Present 8000
+        }
+
+-- | Test account set up for 'bsoUpdateValidator'. The first two accounts are validators, and the
+--  third is delegating to the first.
+updateValidatorTestAccounts ::
+    forall av.
+    (IsAccountVersion av, AVSupportsDelegation av) =>
+    Bool ->
+    [AccountConfig av]
+updateValidatorTestAccounts pendingChangeOrCooldown =
+    [ AccountConfig
+        { acAccountIndex = 0,
+          acAmount = 1_000_000_000_000,
+          acStaking =
+            StakeDetailsBaker
+                { sdStakedCapital = initialStakedAmount,
+                  sdRestakeEarnings = True,
+                  sdPendingChange = pendingChange
+                },
+          acCooldowns = cooldowns
+        },
+      AccountConfig
+        { acAccountIndex = 1,
+          acAmount = 1_000_000_000_000,
+          acStaking =
+            StakeDetailsBaker
+                { sdStakedCapital = initialStakedAmount,
+                  sdRestakeEarnings = True,
+                  sdPendingChange = NoChange
+                },
+          acCooldowns = emptyCooldowns
+        },
+      AccountConfig
+        { acAccountIndex = 2,
+          acAmount = 1_000_000_000_001,
+          acStaking =
+            StakeDetailsDelegator
+                { sdStakedCapital = initialStakedAmount,
+                  sdRestakeEarnings = True,
+                  sdPendingChange = NoChange,
+                  sdDelegationTarget = DelegateToBaker 0
+                },
+          acCooldowns = emptyCooldowns
+        }
+    ]
+  where
+    (pendingChange, cooldowns)
+        | pendingChangeOrCooldown = case sSupportsFlexibleCooldown (accountVersion @av) of
+            STrue -> (NoChange, initialTestCooldowns)
+            SFalse -> (ReduceStake (initialStakedAmount `div` 2) (PendingChangeEffectiveV1 1000), emptyCooldowns)
+        | otherwise = (NoChange, emptyCooldowns)
+
+-- | A configuration for testing 'bsoUpdateValidator'.
+data ValidatorUpdateConfig = ValidatorUpdateConfig
+    { -- | The update to perform
+      vucValidatorUpdate :: ValidatorUpdate,
+      -- | Conditions that should trigger a specific error
+      vucValidatorConditions :: ValidatorConditions,
+      -- | Whether the account should have a pending change or cooldown set initially
+      vucPendingChangeOrCooldown :: Bool,
+      -- | A description of the configuration
+      vucDescription :: String
+    }
+
+instance Show ValidatorUpdateConfig where
+    show = vucDescription
+
+-- | Test cases for updating a validator. These cover a very broad combination of updates to
+--  different fields.
+validatorUpdateCases :: [ValidatorUpdateConfig]
+validatorUpdateCases = do
+    (vuKeys, vuKeysDesc, vcAggregationKeyDuplicate) <-
+        [ (Nothing, "none", False),
+          (Just (makeBakerKeyUpdate 0), "old keys", False),
+          (Just (makeBakerKeyUpdate 2), "fresh keys", False),
+          (Just (makeBakerKeyUpdate 1), "duplicate keys", True)
+            ]
+    (vuCapital, vuCapitalDesc, vcUnderThreshold) <-
+        [ (Just 600_000_000_000, "increase", False),
+          (Just initialStakedAmount, "same", False),
+          (Just 1_000_000_000, "decrease", False),
+          (Just 999_999_999, "insufficient", True),
+          (Just 0, "zero", False),
+          (Nothing, "no change", False)
+            ]
+    (vuRestakeEarnings, vuRestakeEarningsDesc) <-
+        [ (Just True, "restake"),
+          (Just False, "no restake"),
+          (Nothing, "no change")
+            ]
+    (vuOpenForDelegation, vuOpenForDelegationDesc) <-
+        [ (Just OpenForAll, "open"),
+          (Just ClosedForAll, "closed for all"),
+          (Just ClosedForNew, "closed for new"),
+          (Nothing, "no change")
+            ]
+    (vuMetadataURL, vuMetadataURLDesc) <-
+        [ (Just (UrlText "Some URL"), "same URL"),
+          (Just (UrlText "Some new URL"), "new URL"),
+          (Nothing, "no change")
+            ]
+    (vuTransactionFeeCommission, vuTransactionFeeCommissionDesc, vcTransactionFeeNotInRange) <-
+        [ (Just (makeAmountFraction 100), "in range", False),
+          (Just (makeAmountFraction 201), "out of range", True),
+          (Just (makeAmountFraction 150), "same", False),
+          (Nothing, "no change", False)
+            ]
+    (vuBakingRewardCommission, vuBakingRewardCommissionDesc, vcBakingRewardNotInRange) <-
+        [ (Just (makeAmountFraction 500), "in range", False),
+          (Just (makeAmountFraction 400), "out of range", True),
+          (Just (makeAmountFraction 550), "same", False),
+          (Nothing, "no change", False)
+            ]
+    (vuFinalizationRewardCommission, vuFinalizationRewardCommissionDesc, vcFinalizationRewardNotInRange) <-
+        [ (Just (makeAmountFraction 300), "in range", False),
+          (Just (makeAmountFraction 401), "out of range", True),
+          (Just (makeAmountFraction 350), "same", False),
+          (Nothing, "no change", False)
+            ]
+    let vucValidatorUpdate = ValidatorUpdate{..}
+    let vucValidatorConditions = ValidatorConditions{..}
+    vucPendingChangeOrCooldown <- [True, False]
+    let vucDescription =
+            "keys: "
+                <> vuKeysDesc
+                <> ", capital: "
+                <> vuCapitalDesc
+                <> ", restake: "
+                <> vuRestakeEarningsDesc
+                <> ", open: "
+                <> vuOpenForDelegationDesc
+                <> ", URL: "
+                <> vuMetadataURLDesc
+                <> ", transaction fee: "
+                <> vuTransactionFeeCommissionDesc
+                <> ", baking reward: "
+                <> vuBakingRewardCommissionDesc
+                <> ", finalization reward: "
+                <> vuFinalizationRewardCommissionDesc
+                <> ( if vucPendingChangeOrCooldown
+                        then ", pending change/cooldown"
+                        else ", no pending change/cooldown"
+                   )
+    return $ ValidatorUpdateConfig{..}
+
+-- | Commission ranges that narrowly include the commission rates used in the test cases.
+narrowCommissionRanges :: CommissionRanges
+narrowCommissionRanges =
+    CommissionRanges
+        { _transactionCommissionRange = InclusiveRange (makeAmountFraction 100) (makeAmountFraction 200),
+          _finalizationCommissionRange = InclusiveRange (makeAmountFraction 300) (makeAmountFraction 400),
+          _bakingCommissionRange = InclusiveRange (makeAmountFraction 500) (makeAmountFraction 600)
+        }
+
+-- | Commission ranges that include the full range of possible commission rates.
+fullCommissionRanges :: CommissionRanges
+fullCommissionRanges =
+    CommissionRanges
+        { _transactionCommissionRange = fullRange,
+          _finalizationCommissionRange = fullRange,
+          _bakingCommissionRange = fullRange
+        }
+  where
+    fullRange = InclusiveRange (makeAmountFraction 0) (makeAmountFraction 100_000)
+
+-- | Test updating a validator in various possible ways.
+testUpdateValidator ::
+    forall pv.
+    ( IsProtocolVersion pv,
+      SupportsDelegation (AccountVersionFor pv) ~ 'True,
+      PoolParametersVersionFor (ChainParametersVersionFor pv) ~ 'PoolParametersVersion1
+    ) =>
+    SProtocolVersion pv ->
+    -- | If 'True', test all cases.
+    Bool ->
+    Spec
+testUpdateValidator spv True = describe "bsoUpdateValidator" $ do
+    forM_ validatorUpdateCases $ \conf -> do
+        it (show conf) $ runUpdateValidatorTest spv narrowCommissionRanges conf
+testUpdateValidator spv False = do
+    it "bsoUpdateValidator (random cases)" $
+        withMaxSuccess 1000 $
+            forAll (elements validatorUpdateCases) $
+                runUpdateValidatorTest spv narrowCommissionRanges
+
+-- | This test case is to detect possible confusion between the different commission rates.
+testUpdateValidatorOverlappingCommissions ::
+    ( IsProtocolVersion pv,
+      SupportsDelegation (AccountVersionFor pv) ~ 'True,
+      PoolParametersVersionFor (ChainParametersVersionFor pv) ~ 'PoolParametersVersion1
+    ) =>
+    SProtocolVersion pv ->
+    SpecWith ()
+testUpdateValidatorOverlappingCommissions spv =
+    it "bsoUpdateValidator - overlapping commissions" $
+        forAll genCases $
+            runUpdateValidatorTest spv fullCommissionRanges
+  where
+    genCases = do
+        let options = [Nothing, Just (AmountFraction 150), Just (AmountFraction 350), Just (AmountFraction 550), Just (AmountFraction 100_000)]
+        vuTransactionFeeCommission <- elements options
+        vuBakingRewardCommission <- elements options
+        vuFinalizationRewardCommission <- elements options
+        let vucValidatorUpdate =
+                ValidatorUpdate
+                    { vuKeys = Nothing,
+                      vuCapital = Nothing,
+                      vuRestakeEarnings = Nothing,
+                      vuOpenForDelegation = Nothing,
+                      vuMetadataURL = Nothing,
+                      ..
+                    }
+        let vucPendingChangeOrCooldown = False
+        let vucValidatorConditions =
+                ValidatorConditions
+                    { vcUnderThreshold = False,
+                      vcTransactionFeeNotInRange = False,
+                      vcBakingRewardNotInRange = False,
+                      vcFinalizationRewardNotInRange = False,
+                      vcAggregationKeyDuplicate = False
+                    }
+        let vucDescription =
+                "transaction fee: "
+                    <> show vuTransactionFeeCommission
+                    <> ", baking reward: "
+                    <> show vuBakingRewardCommission
+                    <> ", finalization reward: "
+                    <> show vuFinalizationRewardCommission
+        return ValidatorUpdateConfig{..}
+
+-- | Run a test on 'bsoUpdateValidator', checking the behaviour is as expected.
+runUpdateValidatorTest ::
+    forall pv.
+    ( IsProtocolVersion pv,
+      SupportsDelegation (AccountVersionFor pv) ~ 'True,
+      PoolParametersVersionFor (ChainParametersVersionFor pv) ~ 'PoolParametersVersion1
+    ) =>
+    SProtocolVersion pv ->
+    CommissionRanges ->
+    ValidatorUpdateConfig ->
+    IO ()
+runUpdateValidatorTest spv commissionRanges ValidatorUpdateConfig{vucValidatorUpdate = vu, vucValidatorConditions = vc, ..} = runTestBlockState @pv $ do
+    initialAccounts <- mapM makeDummyAccount (updateValidatorTestAccounts vucPendingChangeOrCooldown)
+    initialBS <- mkInitialState initialAccounts
+    initialAccountBaker <- fmap fromJust . getAccountBaker . fromJust =<< bsoGetAccountByIndex initialBS 0
+    res <- bsoUpdateValidator initialBS 1000 0 vu
+    let expect
+            | vcAggregationKeyDuplicate vc = Left (VCFDuplicateAggregationKey (bkuAggregationKey (fromJust $ vuKeys vu)))
+            | vcTransactionFeeNotInRange vc = Left VCFTransactionFeeCommissionNotInRange
+            | vcBakingRewardNotInRange vc = Left VCFBakingRewardCommissionNotInRange
+            | vcFinalizationRewardNotInRange vc = Left VCFFinalizationRewardCommissionNotInRange
+            | vucPendingChangeOrCooldown,
+              isJust (vuCapital vu),
+              not $ supportsFlexibleCooldown $ accountVersionFor $ demoteProtocolVersion (protocolVersion @pv) =
+                Left VCFChangePending
+            | vcUnderThreshold vc = Left VCFStakeUnderThreshold
+            | otherwise = Right ()
+    liftIO $ void res `shouldBe` expect
+    forM_ res $ \(changes, bs) -> do
+        -- We check that the changes are as expected.
+        let expectChanges = execWriter $ do
+                forM_ (vuKeys vu) $ \keys -> tell [BakerConfigureUpdateKeys keys]
+                forM_ (vuRestakeEarnings vu) $ \restake -> tell [BakerConfigureRestakeEarnings restake]
+                forM_ (vuOpenForDelegation vu) $ \open -> tell [BakerConfigureOpenForDelegation open]
+                forM_ (vuMetadataURL vu) $ \url -> tell [BakerConfigureMetadataURL url]
+                forM_ (vuTransactionFeeCommission vu) $ \fee -> tell [BakerConfigureTransactionFeeCommission fee]
+                forM_ (vuBakingRewardCommission vu) $ \fee -> tell [BakerConfigureBakingRewardCommission fee]
+                forM_ (vuFinalizationRewardCommission vu) $ \fee -> tell [BakerConfigureFinalizationRewardCommission fee]
+                forM_ (vuCapital vu) $ \capital ->
+                    tell $
+                        if capital >= initialStakedAmount
+                            then [BakerConfigureStakeIncreased capital]
+                            else [BakerConfigureStakeReduced capital]
+        liftIO $ changes `shouldBe` expectChanges
+        -- To check that the active stake indexes are updated correctly, we construct a new
+        -- block state using the current state of the accounts (which will build the indexes
+        -- anew) and check that the indexes match.
+        bsp <- loadPBS bs
+        theAccounts <- Accounts.foldAccountsDesc (\l a -> pure (a : l)) [] (bspAccounts bsp)
+        newBSP <- loadPBS =<< mkInitialState theAccounts
+        expectedActiveBakers <- loadActiveBakers (_birkActiveBakers $ bspBirkParameters newBSP)
+        actualActiveBakers <- loadActiveBakers (_birkActiveBakers $ bspBirkParameters bsp)
+        liftIO $ actualActiveBakers `shouldBe` expectedActiveBakers
+        () <- case flexibleCooldown of
+            STrue -> do
+                -- Check that the cooldowns are correct
+                newCooldowns <- checkCooldowns bs
+                let bakerInitialCooldowns
+                        | vucPendingChangeOrCooldown = initialTestCooldowns
+                        | otherwise = emptyCooldowns
+                let bakerExpectedCooldowns = case vuCapital vu of
+                        Just newCapital -> case newCapital `compare` initialStakedAmount of
+                            LT -> addPrePreCooldown (initialStakedAmount - newCapital) bakerInitialCooldowns
+                            EQ -> bakerInitialCooldowns
+                            GT -> reactivateCooldownAmount (newCapital - initialStakedAmount) bakerInitialCooldowns
+                        _ -> bakerInitialCooldowns
+                liftIO $ newCooldowns `shouldBe` [bakerExpectedCooldowns, emptyCooldowns, emptyCooldowns]
+                when (vuCapital vu == Just 0) $ do
+                    -- Check that account 2 delegates to passive now
+                    acc2 <- fromJust <$> bsoGetAccountByIndex bs 2
+                    getAccountDelegator acc2 >>= \case
+                        Just del ->
+                            liftIO $ (del ^. delegationTarget) `shouldBe` DelegatePassive
+                        Nothing -> liftIO $ expectationFailure "Account 2 should have a delegator"
+            SFalse -> return ()
+        acc0 <- fromJust <$> bsoGetAccountByIndex bs 0
+        let updateCapital newCapital
+                | newCapital < initialStakedAmount,
+                  SFalse <- flexibleCooldown =
+                    bakerPendingChange
+                        .~ (if newCapital == 0 then RemoveStake else ReduceStake newCapital)
+                            (PendingChangeEffectiveV1 (24 * 60 * 60 * 1000 + 1000))
+                | otherwise = stakedAmount .~ newCapital
+        let expectedAccountBaker
+                | STrue <- flexibleCooldown, vuCapital vu == Just 0 = Nothing
+                | otherwise =
+                    Just $
+                        initialAccountBaker
+                            & maybe
+                                id
+                                ( \keys ->
+                                    (bakerElectionVerifyKey .~ bkuElectionKey keys)
+                                        . (bakerSignatureVerifyKey .~ bkuSignKey keys)
+                                        . (bakerAggregationVerifyKey .~ bkuAggregationKey keys)
+                                )
+                                (vuKeys vu)
+                            & maybe id updateCapital (vuCapital vu)
+                            & maybe id (stakeEarnings .~) (vuRestakeEarnings vu)
+                            & maybe id (poolOpenStatus .~) (vuOpenForDelegation vu)
+                            & maybe id (poolMetadataUrl .~) (vuMetadataURL vu)
+                            & maybe id (poolCommissionRates . finalizationCommission .~) (vuFinalizationRewardCommission vu)
+                            & maybe id (poolCommissionRates . bakingCommission .~) (vuBakingRewardCommission vu)
+                            & maybe id (poolCommissionRates . transactionCommission .~) (vuTransactionFeeCommission vu)
+        actualAccountBaker <- getAccountBaker acc0
+        liftIO $ actualAccountBaker `shouldBe` expectedAccountBaker
+  where
+    flexibleCooldown = sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv))
+    seedState :: SeedState (SeedStateVersionFor pv)
+    seedState = case sSeedStateVersionFor (protocolVersion @pv) of
+        SSeedStateVersion0 -> initialSeedStateV0 (Hash.hash "NONCE") 1000
+        SSeedStateVersion1 -> initialSeedStateV1 (Hash.hash "NONCE") 1000
+    minEquity = 1_000_000_000
+    chainParams =
+        DummyData.dummyChainParameters @(ChainParametersVersionFor pv)
+            & cpPoolParameters . ppMinimumEquityCapital .~ minEquity
+            & cpPoolParameters . ppCommissionBounds
+                .~ commissionRanges
+    mkInitialState accounts =
+        hpbsPointers
+            <$> initialPersistentState @pv
+                seedState
+                DummyData.dummyCryptographicParameters
+                accounts
+                DummyData.dummyIdentityProviders
+                DummyData.dummyArs
+                (withIsAuthorizationsVersionForPV spv DummyData.dummyKeyCollection)
+                chainParams
+
+tests :: Word -> Spec
+tests lvl = parallel $ describe "Validator" $ do
+    describe "P6" $ do
+        testAddValidatorAllCases SP6
+        testUpdateValidator SP6 (lvl > 1)
+        testUpdateValidatorOverlappingCommissions SP6
+    describe "P7" $ do
+        testAddValidatorAllCases SP7
+        testUpdateValidator SP7 (lvl > 1)
+        testUpdateValidatorOverlappingCommissions SP7
diff --git a/concordium-consensus/tests/globalstate/Spec.hs b/concordium-consensus/tests/globalstate/Spec.hs
index ebaec6075..a15f345fa 100644
--- a/concordium-consensus/tests/globalstate/Spec.hs
+++ b/concordium-consensus/tests/globalstate/Spec.hs
@@ -10,6 +10,7 @@ import qualified GlobalStateTests.AccountsMigrationP6ToP7 (tests)
 import qualified GlobalStateTests.BlobStore (tests)
 import qualified GlobalStateTests.BlockHash (tests)
 import qualified GlobalStateTests.Cache (tests)
+import qualified GlobalStateTests.ConfigureValidator (tests)
 import qualified GlobalStateTests.CooldownProcessing (tests)
 import qualified GlobalStateTests.CooldownQueue (tests)
 import qualified GlobalStateTests.DifferenceMap (tests)
@@ -57,3 +58,4 @@ main = atLevel $ \lvl -> hspec $ do
     GlobalStateTests.AccountsMigrationP6ToP7.tests
     GlobalStateTests.CooldownQueue.tests
     GlobalStateTests.CooldownProcessing.tests
+    GlobalStateTests.ConfigureValidator.tests lvl

From d72ce77db2ec8463954be2b4a15fba2bdfbaae97 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Fri, 9 Aug 2024 17:53:02 +0200
Subject: [PATCH 55/81] Configure delegator tests

---
 .../GlobalState/Persistent/BlockState.hs      |  12 +-
 .../GlobalStateTests/BlockStateHelpers.hs     | 111 +++-
 .../GlobalStateTests/ConfigureDelegator.hs    | 489 ++++++++++++++++++
 .../GlobalStateTests/ConfigureValidator.hs    |  69 +--
 .../tests/globalstate/Spec.hs                 |   2 +
 5 files changed, 606 insertions(+), 77 deletions(-)
 create mode 100644 concordium-consensus/tests/globalstate/GlobalStateTests/ConfigureDelegator.hs

diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
index e2bd67289..966f5e977 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
@@ -298,6 +298,14 @@ initialBirkParameters accounts seedState _bakerFinalizationCommitteeParameters =
     -- Iterate the accounts again accumulate all relevant information.
     IBPFromAccountsAccum{..} <- foldM (accumFromAccounts ibpcdToBaker) initialIBPFromAccountsAccum accounts
 
+    -- The total stake from bakers and delegators
+    let totalStake = case delegationSupport @av of
+            SAVDelegationNotSupported -> aibpStakedTotal
+            SAVDelegationSupported ->
+                aibpStakedTotal
+                    + sum ((^. delegatorTotalCapital) <$> ibpcdToBaker)
+                    + ibpcdToPassive ^. delegatorTotalCapital
+
     persistentActiveBakers <-
         refMake $!
             PersistentActiveBakers
@@ -306,13 +314,13 @@ initialBirkParameters accounts seedState _bakerFinalizationCommitteeParameters =
                   _passiveDelegators = ibpcdToPassive,
                   _totalActiveCapital = case delegationSupport @av of
                     SAVDelegationNotSupported -> TotalActiveCapitalV0
-                    SAVDelegationSupported -> TotalActiveCapitalV1 aibpStakedTotal
+                    SAVDelegationSupported -> TotalActiveCapitalV1 totalStake
                 }
 
     nextEpochBakers <- do
         _bakerInfos <- refMake $ BakerInfos aibpBakerInfoRefs
         _bakerStakes <- refMake $ BakerStakes aibpBakerStakes
-        refMake PersistentEpochBakers{_bakerTotalStake = aibpStakedTotal, ..}
+        refMake PersistentEpochBakers{_bakerTotalStake = totalStake, ..}
 
     return $!
         PersistentBirkParameters
diff --git a/concordium-consensus/tests/globalstate/GlobalStateTests/BlockStateHelpers.hs b/concordium-consensus/tests/globalstate/GlobalStateTests/BlockStateHelpers.hs
index f9efac15f..c596468f0 100644
--- a/concordium-consensus/tests/globalstate/GlobalStateTests/BlockStateHelpers.hs
+++ b/concordium-consensus/tests/globalstate/GlobalStateTests/BlockStateHelpers.hs
@@ -1,7 +1,6 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
@@ -41,6 +40,11 @@ import qualified Concordium.GlobalState.Persistent.ReleaseSchedule as ReleaseSch
 import qualified Concordium.GlobalState.Persistent.Trie as Trie
 import Concordium.Scheduler.DummyData
 
+import qualified Concordium.Crypto.SHA256 as Hash
+import Concordium.GlobalState.Parameters
+import qualified Concordium.GlobalState.Persistent.Accounts as Accounts
+import Concordium.GlobalState.Persistent.Bakers
+import Concordium.Types.SeedState
 import GlobalStateTests.Accounts (NoLoggerT (..), runNoLoggerT)
 
 -- | Construct a dummy account with the specified cooldowns.
@@ -65,19 +69,35 @@ data AccountConfig (av :: AccountVersion) = AccountConfig
     { acAccountIndex :: AccountIndex,
       acAmount :: Amount,
       acStaking :: StakeDetails av,
+      acPoolInfo :: Maybe BakerPoolInfo,
       acCooldowns :: Cooldowns
     }
     deriving (Show)
 
+dummyBakerPoolInfo :: BakerPoolInfo
+dummyBakerPoolInfo =
+    BakerPoolInfo
+        { _poolOpenStatus = OpenForAll,
+          _poolMetadataUrl = UrlText "Some URL",
+          _poolCommissionRates =
+            -- Note: these commission rates are significant for the ConfigureValidator tests
+            CommissionRates
+                { _finalizationCommission = makeAmountFraction 350,
+                  _bakingCommission = makeAmountFraction 550,
+                  _transactionCommission = makeAmountFraction 150
+                }
+        }
+
 -- | Set the staking details for an account.
 setAccountStakeDetails ::
     (MonadBlobStore m, AVSupportsDelegation av, IsAccountVersion av) =>
     AccountIndex ->
     StakeDetails av ->
+    Maybe BakerPoolInfo ->
     PersistentAccount av ->
     m (PersistentAccount av)
-setAccountStakeDetails _ StakeDetailsNone acc = return acc
-setAccountStakeDetails ai StakeDetailsBaker{..} acc =
+setAccountStakeDetails _ StakeDetailsNone _ acc = return acc
+setAccountStakeDetails ai StakeDetailsBaker{..} mPoolInfo acc =
     setAccountStakePendingChange sdPendingChange
         =<< addAccountBakerV1 bie sdStakedCapital sdRestakeEarnings acc
   where
@@ -87,19 +107,8 @@ setAccountStakeDetails ai StakeDetailsBaker{..} acc =
               _bieBakerPoolInfo = poolInfo
             }
     fulBaker = DummyData.mkFullBaker (fromIntegral ai) (BakerId ai) ^. _1
-    poolInfo =
-        BakerPoolInfo
-            { _poolOpenStatus = OpenForAll,
-              _poolMetadataUrl = UrlText "Some URL",
-              _poolCommissionRates =
-                -- Note: these commission rates are significant for the ConfigureValidator tests
-                CommissionRates
-                    { _finalizationCommission = makeAmountFraction 350,
-                      _bakingCommission = makeAmountFraction 550,
-                      _transactionCommission = makeAmountFraction 150
-                    }
-            }
-setAccountStakeDetails ai StakeDetailsDelegator{..} acc =
+    poolInfo = fromMaybe dummyBakerPoolInfo mPoolInfo
+setAccountStakeDetails ai StakeDetailsDelegator{..} _ acc =
     setAccountStakePendingChange sdPendingChange =<< addAccountDelegator del acc
   where
     del =
@@ -122,7 +131,7 @@ makeDummyAccount ::
     m (PersistentAccount av)
 makeDummyAccount AccountConfig{..} = do
     acc0 <- makeTestAccountFromSeed @av acAmount (fromIntegral acAccountIndex)
-    acc1 <- setAccountStakeDetails acAccountIndex acStaking acc0
+    acc1 <- setAccountStakeDetails acAccountIndex acStaking acPoolInfo acc0
     case sSupportsFlexibleCooldown (accountVersion @av) of
         STrue -> case acc1 of
             PAV3 acc -> do
@@ -199,3 +208,71 @@ checkCooldowns pbs = do
     actualPrePreCooldowns <- Set.fromList <$> Cooldown.loadAccountList (aic ^. Cooldown.prePreCooldown)
     liftIO $ assertEqual "Pre-pre-cooldown set" prePreCooldowns actualPrePreCooldowns
     return (reverse theCooldowns)
+
+dummySeedState :: forall pv. SProtocolVersion pv -> SeedState (SeedStateVersionFor pv)
+dummySeedState spv = case sSeedStateVersionFor spv of
+    SSeedStateVersion0 -> initialSeedStateV0 (Hash.hash "NONCE") 1000
+    SSeedStateVersion1 -> initialSeedStateV1 (Hash.hash "NONCE") 1000
+
+-- | Representation of the active bakers in the block state.
+data ActiveBakers = ActiveBakers
+    { abActiveBakers :: Map.Map BakerId ([DelegatorId], Amount),
+      abAggregationKeys :: [BakerAggregationVerifyKey],
+      abPassiveDelegators :: ([DelegatorId], Amount),
+      abTotalActiveCapital :: Amount
+    }
+    deriving (Eq, Show)
+
+-- | Load the active bakers from the block state.
+-- Note, 'abTotalActiveCapital' will be 0 if the block state is from a version that does not store
+-- this value.
+loadActiveBakers :: forall av m. (MonadBlobStore m, IsAccountVersion av) => BufferedRef (PersistentActiveBakers av) -> m ActiveBakers
+loadActiveBakers pabRef = do
+    PersistentActiveBakers{..} <- refLoad pabRef
+    bakers0 <- Trie.toMap _activeBakers
+    abActiveBakers <- mapM loadActiveDelegators bakers0
+    abAggregationKeys <- Map.keys <$> Trie.toMap _aggregationKeys
+    abPassiveDelegators <- loadActiveDelegators _passiveDelegators
+    let abTotalActiveCapital = case _totalActiveCapital of
+            TotalActiveCapitalV0 -> 0
+            TotalActiveCapitalV1 capital -> capital
+    return ActiveBakers{..}
+  where
+    loadActiveDelegators :: PersistentActiveDelegators av -> m ([DelegatorId], Amount)
+    loadActiveDelegators PersistentActiveDelegatorsV0 = return ([], 0)
+    loadActiveDelegators (PersistentActiveDelegatorsV1 delegators capital) = do
+        dlgs <- Trie.keysAsc delegators
+        return (dlgs, capital)
+
+-- | Check that the active bakers in the block state are correct for the accounts by constructing
+--  a fresh block state from the accounts and comparing the active bakers.
+checkActiveBakers :: forall pv m. (SupportsPersistentState pv m) => PersistentBlockState pv -> m ()
+checkActiveBakers bs = do
+    bsp <- loadPBS bs
+    theAccounts <- Accounts.foldAccountsDesc (\l a -> pure (a : l)) [] (bspAccounts bsp)
+    newBSP <- loadPBS . hpbsPointers =<< mkInitialState theAccounts
+    expectedActiveBakers <- loadActiveBakers (_birkActiveBakers $ bspBirkParameters newBSP)
+    actualActiveBakers <- loadActiveBakers (_birkActiveBakers $ bspBirkParameters bsp)
+    liftIO $ assertEqual "ActiveBakers" expectedActiveBakers actualActiveBakers
+  where
+    spv = protocolVersion @pv
+    mkInitialState accounts =
+        initialPersistentState @pv
+            (dummySeedState spv)
+            DummyData.dummyCryptographicParameters
+            accounts
+            DummyData.dummyIdentityProviders
+            DummyData.dummyArs
+            (withIsAuthorizationsVersionForPV spv DummyData.dummyKeyCollection)
+            DummyData.dummyChainParameters
+
+dumpState :: (SupportsPersistentState pv m) => HashedPersistentBlockState pv -> m ()
+dumpState hpbs = do
+    bsp <- loadPBS (hpbsPointers hpbs)
+    liftIO $ putStrLn "== Accounts =="
+
+    Accounts.foldAccounts (\_ -> showPA) () (bspAccounts bsp)
+    return ()
+  where
+    showPA pa = do
+        liftIO . print =<< toTransientAccount pa
diff --git a/concordium-consensus/tests/globalstate/GlobalStateTests/ConfigureDelegator.hs b/concordium-consensus/tests/globalstate/GlobalStateTests/ConfigureDelegator.hs
new file mode 100644
index 000000000..a96b0f3df
--- /dev/null
+++ b/concordium-consensus/tests/globalstate/GlobalStateTests/ConfigureDelegator.hs
@@ -0,0 +1,489 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+module GlobalStateTests.ConfigureDelegator where
+
+import Concordium.GlobalState.Account
+import Concordium.GlobalState.BakerInfo
+import Concordium.GlobalState.BlockState
+import Concordium.GlobalState.CooldownQueue
+import qualified Concordium.GlobalState.DummyData as DummyData
+import Concordium.GlobalState.Persistent.BlockState
+import Concordium.Types
+import Concordium.Types.Accounts
+import Concordium.Types.Execution
+import Concordium.Types.Option
+import Concordium.Types.Parameters
+import Control.Monad
+import Control.Monad.IO.Class
+import Control.Monad.Writer.CPS
+import Data.Bool.Singletons
+import qualified Data.Map.Strict as Map
+import Data.Maybe
+import Data.Ratio
+import GlobalStateTests.BlockStateHelpers
+import Lens.Micro.Platform
+import Test.Hspec
+import Test.QuickCheck
+
+-- | Some non-trivial cooldowns that may be set on an account for testing.
+initialTestCooldowns :: Cooldowns
+initialTestCooldowns =
+    Cooldowns
+        { inCooldown = Map.fromList [(1000, 2), (2000, 2)],
+          prePreCooldown = Present 2,
+          preCooldown = Present 2
+        }
+
+baseAmount :: Amount
+baseAmount = 100
+
+baseStake :: Amount
+baseStake = 1
+
+-- | Generate a list of test accounts with at least one baker, one delegator and one
+--  non-staking account.
+genTestAccounts :: forall av. (IsAccountVersion av, AVSupportsDelegation av) => Gen [AccountConfig av]
+genTestAccounts = do
+    let nAccounts = 10
+    let accountIndices = [0 .. nAccounts - 1]
+    nBakers <- choose (1, nAccounts - 2)
+    bakerIndices <- take nBakers <$> shuffle accountIndices
+    nDelegators <- choose (1, nAccounts - nBakers - 1)
+    let nonBakers = filter (`notElem` bakerIndices) accountIndices
+    delegatorIndices <- take nDelegators <$> shuffle nonBakers
+    bakerStatuses <- vectorOf nAccounts (frequency [(8, return OpenForAll), (1, return ClosedForAll), (1, return ClosedForNew)])
+    forM accountIndices $ \ai -> do
+        stake <- (baseStake *) . fromInteger <$> choose (1, 10)
+        delTarget <-
+            elements $
+                DelegatePassive
+                    : [DelegateToBaker (fromIntegral bi) | bi <- bakerIndices, bakerStatuses !! bi /= ClosedForAll]
+        let poolStatus = bakerStatuses !! ai
+        (cooldowns, pendingChange) <- case sSupportsFlexibleCooldown (accountVersion @av) of
+            STrue -> (,NoChange) <$> elements [emptyCooldowns, initialTestCooldowns]
+            SFalse ->
+                (emptyCooldowns,)
+                    <$> oneof
+                        [ return NoChange,
+                          ReduceStake . fromInteger <$> choose (1, fromIntegral stake) <*> pure (PendingChangeEffectiveV1 1000),
+                          return $ RemoveStake (PendingChangeEffectiveV1 1000)
+                        ]
+        return $
+            AccountConfig
+                { acAccountIndex = fromIntegral ai,
+                  acAmount = baseAmount,
+                  acStaking =
+                    if ai `elem` bakerIndices
+                        then
+                            StakeDetailsBaker
+                                { sdStakedCapital = stake,
+                                  sdRestakeEarnings = True,
+                                  sdPendingChange = pendingChange
+                                }
+                        else
+                            if ai `elem` delegatorIndices
+                                then
+                                    StakeDetailsDelegator
+                                        { sdStakedCapital = stake,
+                                          sdRestakeEarnings = True,
+                                          sdPendingChange = pendingChange,
+                                          sdDelegationTarget = delTarget
+                                        }
+                                else StakeDetailsNone,
+                  acPoolInfo = Just dummyBakerPoolInfo{_poolOpenStatus = poolStatus},
+                  acCooldowns = cooldowns
+                }
+
+data DelegatorTestConfig av = DelegatorTestConfig
+    { dtcAccounts :: [AccountConfig av],
+      dtcUseAccount :: AccountIndex,
+      dtcCapitalBound :: CapitalBound,
+      dtcLeverageBound :: LeverageFactor
+    }
+    deriving (Show)
+
+-- | Determine if the target is open for delegation. Returns 'Nothing' if the target is not a baker,
+--  'Just True' if the target is open for delegation and 'Just False' if the target is closed for
+--  further delegation.
+dtcTargetOpen :: DelegatorTestConfig av -> DelegationTarget -> Maybe Bool
+dtcTargetOpen _ DelegatePassive = Just True
+dtcTargetOpen DelegatorTestConfig{..} (DelegateToBaker bi)
+    | fromIntegral bi < length dtcAccounts,
+      AccountConfig{acStaking = StakeDetailsBaker{}, ..} <- dtcAccounts !! fromIntegral bi =
+        case acPoolInfo of
+            Just BakerPoolInfo{_poolOpenStatus = OpenForAll} -> Just True
+            Just _ -> Just False
+            _ -> Nothing
+    | otherwise = Nothing
+
+dtcTotalStake :: DelegatorTestConfig av -> Amount
+dtcTotalStake DelegatorTestConfig{..} =
+    sum $ map (accountStakedCapital . acStaking) dtcAccounts
+  where
+    accountStakedCapital StakeDetailsBaker{..} = sdStakedCapital
+    accountStakedCapital StakeDetailsDelegator{..} = sdStakedCapital
+    accountStakedCapital _ = 0
+
+dtcBakerStake :: DelegatorTestConfig av -> BakerId -> Maybe (Amount, Amount)
+dtcBakerStake DelegatorTestConfig{..} bi = (,delegatorStakes) <$> bkrStake
+  where
+    bkrStake
+        | fromIntegral bi < length dtcAccounts,
+          AccountConfig{acStaking = StakeDetailsBaker{..}} <- dtcAccounts !! fromIntegral bi =
+            Just sdStakedCapital
+        | otherwise = Nothing
+    delegatorStakes = sum $ map delStake dtcAccounts
+    delStake AccountConfig{acStaking = StakeDetailsDelegator{..}}
+        | sdDelegationTarget == DelegateToBaker bi = sdStakedCapital
+    delStake _ = 0
+
+dtcCooldowns :: DelegatorTestConfig av -> [Cooldowns]
+dtcCooldowns DelegatorTestConfig{..} = map acCooldowns dtcAccounts
+
+expectedAddResult :: DelegatorTestConfig av -> DelegatorAdd -> Either DelegatorConfigureFailure ()
+expectedAddResult dtc@DelegatorTestConfig{..} DelegatorAdd{..}
+    | Just False <- targetOpen = Left DCFPoolClosed
+    | Nothing <- targetOpen,
+      DelegateToBaker bid <- daDelegationTarget =
+        Left $ DCFInvalidDelegationTarget bid
+    | DelegateToBaker bid <- daDelegationTarget,
+      Just (bkrStake, delStake) <- dtcBakerStake dtc bid =
+        if delStake + daCapital + bkrStake > applyLeverageFactor dtcLeverageBound bkrStake
+            then Left DCFPoolStakeOverThreshold
+            else
+                if bkrStake + delStake + daCapital > takeFraction (theCapitalBound dtcCapitalBound) (dtcTotalStake dtc + daCapital)
+                    then Left DCFPoolOverDelegated
+                    else Right ()
+    | otherwise = Right ()
+  where
+    targetOpen = dtcTargetOpen dtc daDelegationTarget
+
+expectedUpdateResult :: forall av. (IsAccountVersion av) => DelegatorTestConfig av -> DelegatorUpdate -> Either DelegatorConfigureFailure ()
+expectedUpdateResult dtc@DelegatorTestConfig{..} DelegatorUpdate{..}
+    | Just t <- duDelegationTarget,
+      Just False <- dtcTargetOpen dtc t =
+        Left DCFPoolClosed
+    | Just t@(DelegateToBaker bid) <- duDelegationTarget,
+      Nothing <- dtcTargetOpen dtc t =
+        Left $ DCFInvalidDelegationTarget bid
+    | Just _ <- duCapital, changePending = Left DCFChangePending
+    | DelegateToBaker bid <- newTarget,
+      oldTarget /= newTarget || oldCapital < newCapital,
+      -- not flexibleCooldown || newCapital > 0 || oldTarget /= newTarget,
+      Just (bkrStake, delStake) <- dtcBakerStake dtc bid =
+        if
+            | applyAmountDelta deltaPool (delStake + bkrStake)
+                > applyLeverageFactor dtcLeverageBound bkrStake ->
+                Left DCFPoolStakeOverThreshold
+            | applyAmountDelta deltaPool (bkrStake + delStake)
+                > takeFraction
+                    (theCapitalBound dtcCapitalBound)
+                    (applyAmountDelta delta $ dtcTotalStake dtc) ->
+                Left DCFPoolOverDelegated
+            | otherwise -> Right ()
+    | otherwise = Right ()
+  where
+    flexibleCooldown = case sSupportsFlexibleCooldown (accountVersion @av) of
+        STrue -> True
+        SFalse -> False
+    senderAccount = dtcAccounts !! fromIntegral dtcUseAccount
+    (oldCapital, oldTarget, changePending) = case acStaking senderAccount of
+        StakeDetailsDelegator{..} -> (sdStakedCapital, sdDelegationTarget, sdPendingChange /= NoChange)
+        _ -> error "Account is not a delegator"
+    delta = maybe 0 (`amountDiff` oldCapital) duCapital
+    newCapital
+        | not flexibleCooldown,
+          Just newCap <- duCapital,
+          newCap < oldCapital =
+            oldCapital
+        | otherwise = fromMaybe oldCapital duCapital
+    deltaPool
+        | Just t <- duDelegationTarget, t /= oldTarget = amountToDelta newCapital
+        | otherwise = amountDiff newCapital oldCapital
+    newTarget = fromMaybe oldTarget duDelegationTarget
+
+showExpectedResult :: Either DelegatorConfigureFailure () -> String
+showExpectedResult (Left DCFInvalidDelegationTarget{}) = "DCFInvalidDelegationTarget"
+showExpectedResult (Left DCFPoolClosed) = "DCFPoolClosed"
+showExpectedResult (Left DCFPoolStakeOverThreshold) = "DCFPoolStakeOverThreshold"
+showExpectedResult (Left DCFPoolOverDelegated) = "DCFPoolOverDelegated"
+showExpectedResult (Left DCFChangePending) = "DCFChangePending"
+showExpectedResult (Right _) = "Success"
+
+runAddDelegatorTest ::
+    forall pv.
+    ( IsProtocolVersion pv,
+      SupportsDelegation (AccountVersionFor pv) ~ 'True,
+      PoolParametersVersionFor (ChainParametersVersionFor pv) ~ 'PoolParametersVersion1
+    ) =>
+    SProtocolVersion pv ->
+    DelegatorTestConfig (AccountVersionFor pv) ->
+    DelegatorAdd ->
+    IO ()
+runAddDelegatorTest spv dtc@DelegatorTestConfig{..} da@DelegatorAdd{..} = runTestBlockState @pv $ do
+    initialAccounts <- mapM makeDummyAccount dtcAccounts
+    initialBS <- mkInitialState initialAccounts
+    res <- bsoAddDelegator initialBS dtcUseAccount da
+    let expect = expectedAddResult dtc da
+    liftIO $ void res `shouldBe` expect
+    forM_ res $ \bs -> do
+        checkActiveBakers bs
+        () <- case flexibleCooldown of
+            STrue -> do
+                newCooldowns <- checkCooldowns bs
+                liftIO $
+                    newCooldowns
+                        `shouldBe` ( dtcCooldowns dtc
+                                        & ix (fromIntegral dtcUseAccount) %~ reactivateCooldownAmount daCapital
+                                   )
+            SFalse -> return ()
+        acc <- fromJust <$> bsoGetAccountByIndex bs dtcUseAccount
+        let expectAccountDelegation =
+                AccountDelegationV1
+                    { _delegationIdentity = DelegatorId dtcUseAccount,
+                      _delegationStakedAmount = daCapital,
+                      _delegationStakeEarnings = daRestakeEarnings,
+                      _delegationTarget = daDelegationTarget,
+                      _delegationPendingChange = NoChange
+                    }
+        actualAccountDelegation <- getAccountDelegator acc
+        liftIO $ actualAccountDelegation `shouldBe` Just expectAccountDelegation
+  where
+    flexibleCooldown = sSupportsFlexibleCooldown (sAccountVersionFor spv)
+    chainParams =
+        DummyData.dummyChainParameters @(ChainParametersVersionFor pv)
+            & cpPoolParameters . ppCapitalBound .~ dtcCapitalBound
+            & cpPoolParameters . ppLeverageBound .~ dtcLeverageBound
+    mkInitialState accounts =
+        hpbsPointers
+            <$> initialPersistentState @pv
+                (dummySeedState spv)
+                DummyData.dummyCryptographicParameters
+                accounts
+                DummyData.dummyIdentityProviders
+                DummyData.dummyArs
+                (withIsAuthorizationsVersionForPV spv DummyData.dummyKeyCollection)
+                chainParams
+
+testAddDelegator ::
+    forall pv.
+    ( IsProtocolVersion pv,
+      SupportsDelegation (AccountVersionFor pv) ~ 'True,
+      PoolParametersVersionFor (ChainParametersVersionFor pv) ~ 'PoolParametersVersion1
+    ) =>
+    SProtocolVersion pv ->
+    Property
+testAddDelegator spv = withMaxSuccess 1000 $ property $ do
+    accounts <- genTestAccounts @(AccountVersionFor pv)
+    useAccount <- elements [acc | acc <- accounts, isUnstaked acc]
+    capital <-
+        oneof
+            [ (baseStake *) . fromInteger <$> choose (1, 20),
+              fromInteger <$> choose (1, fromIntegral baseAmount)
+            ]
+    restake <- arbitrary
+    let chooseNonBaker = elements [DelegateToBaker (BakerId (acAccountIndex acc)) | acc <- accounts, not (isBaker acc)]
+    let chooseBaker = elements [DelegateToBaker (BakerId (acAccountIndex acc)) | acc <- accounts, isBaker acc]
+    let chooseInvalidAccount = elements [DelegateToBaker (BakerId (fromIntegral i)) | i <- [length accounts .. length accounts + 10]]
+    target <-
+        frequency
+            [ (1, return DelegatePassive),
+              (1, chooseNonBaker),
+              (8, chooseBaker),
+              (1, chooseInvalidAccount)
+            ]
+    let delegatorAdd =
+            DelegatorAdd
+                { daCapital = capital,
+                  daRestakeEarnings = restake,
+                  daDelegationTarget = target
+                }
+    capitalBound <- CapitalBound . AmountFraction . fromInteger <$> choose (1, 100_000)
+    leverageDen <- choose (1, 10)
+    leverageNum <- choose (leverageDen, 100)
+    let leverageBound = LeverageFactor $ leverageNum % leverageDen
+    let config =
+            DelegatorTestConfig
+                { dtcAccounts = accounts,
+                  dtcUseAccount = acAccountIndex useAccount,
+                  dtcCapitalBound = capitalBound,
+                  dtcLeverageBound = leverageBound
+                }
+    let lab
+            | target == DelegatePassive = "Passive delegation"
+            | otherwise = showExpectedResult $ expectedAddResult config delegatorAdd
+    return $
+        label lab $
+            counterexample (show config) $
+                counterexample (show delegatorAdd) $
+                    ioProperty $
+                        runAddDelegatorTest spv config delegatorAdd
+  where
+    isUnstaked AccountConfig{acStaking = StakeDetailsNone} = True
+    isUnstaked _ = False
+    isBaker AccountConfig{acStaking = StakeDetailsBaker{}} = True
+    isBaker _ = False
+
+runUpdateDelegatorTest ::
+    forall pv.
+    ( IsProtocolVersion pv,
+      SupportsDelegation (AccountVersionFor pv) ~ 'True,
+      PoolParametersVersionFor (ChainParametersVersionFor pv) ~ 'PoolParametersVersion1
+    ) =>
+    SProtocolVersion pv ->
+    DelegatorTestConfig (AccountVersionFor pv) ->
+    DelegatorUpdate ->
+    IO ()
+runUpdateDelegatorTest spv dtc@DelegatorTestConfig{..} du@DelegatorUpdate{..} = runTestBlockState @pv $ do
+    initialAccounts <- mapM makeDummyAccount dtcAccounts
+    initialBS <- mkInitialState initialAccounts
+    res <- bsoUpdateDelegator initialBS 5000 dtcUseAccount du
+    let expect = expectedUpdateResult dtc du
+    liftIO $ void res `shouldBe` expect
+    forM_ res $ \(changes, bs) -> do
+        liftIO $ changes `shouldBe` expectChanges
+        checkActiveBakers bs
+        () <- case flexibleCooldown of
+            STrue -> do
+                newCooldowns <- checkCooldowns bs
+                liftIO $
+                    newCooldowns
+                        `shouldBe` ( dtcCooldowns dtc
+                                        & ix (fromIntegral dtcUseAccount) %~ updateCooldown
+                                   )
+            SFalse -> return ()
+        acc <- fromJust <$> bsoGetAccountByIndex bs dtcUseAccount
+        let (newPendingChange, newEffectiveCapital) = case flexibleCooldown of
+                SFalse
+                    | Just newCapital <- duCapital,
+                      newCapital == 0 ->
+                        (RemoveStake (PendingChangeEffectiveV1 (24 * 60 * 60 * 1000 + 5000)), oldCapital)
+                    | Just newCapital <- duCapital,
+                      newCapital < oldCapital ->
+                        (ReduceStake newCapital (PendingChangeEffectiveV1 (24 * 60 * 60 * 1000 + 5000)), oldCapital)
+                _ -> (oldPendingChange, fromMaybe oldCapital duCapital)
+
+        let expectAccountDelegation' =
+                AccountDelegationV1
+                    { _delegationIdentity = DelegatorId dtcUseAccount,
+                      _delegationStakedAmount = newEffectiveCapital,
+                      _delegationStakeEarnings = fromMaybe oldRestake duRestakeEarnings,
+                      _delegationTarget = fromMaybe oldTarget duDelegationTarget,
+                      _delegationPendingChange = newPendingChange
+                    }
+        let expectAccountDelegation = case flexibleCooldown of
+                STrue | Just newCapital <- duCapital, newCapital == 0 -> Nothing
+                _ -> Just expectAccountDelegation'
+        actualAccountDelegation <- getAccountDelegator acc
+        liftIO $ actualAccountDelegation `shouldBe` expectAccountDelegation
+  where
+    flexibleCooldown = sSupportsFlexibleCooldown (sAccountVersionFor spv)
+    chainParams =
+        DummyData.dummyChainParameters @(ChainParametersVersionFor pv)
+            & cpPoolParameters . ppCapitalBound .~ dtcCapitalBound
+            & cpPoolParameters . ppLeverageBound .~ dtcLeverageBound
+    (oldCapital, oldRestake, oldTarget, oldPendingChange) =
+        case acStaking (dtcAccounts !! fromIntegral dtcUseAccount) of
+            StakeDetailsDelegator{..} ->
+                (sdStakedCapital, sdRestakeEarnings, sdDelegationTarget, sdPendingChange)
+            _ ->
+                error "Account is not a delegator"
+    updateCooldown = case duCapital of
+        Just newCapital
+            | newCapital > oldCapital -> reactivateCooldownAmount (newCapital - oldCapital)
+            | newCapital < oldCapital -> addPrePreCooldown (oldCapital - newCapital)
+        _ -> id
+    mkInitialState accounts =
+        hpbsPointers
+            <$> initialPersistentState @pv
+                (dummySeedState spv)
+                DummyData.dummyCryptographicParameters
+                accounts
+                DummyData.dummyIdentityProviders
+                DummyData.dummyArs
+                (withIsAuthorizationsVersionForPV spv DummyData.dummyKeyCollection)
+                chainParams
+    expectChanges = execWriter $ do
+        forM_ duDelegationTarget $ tell . (: []) . DelegationConfigureDelegationTarget
+        forM_ duRestakeEarnings $ tell . (: []) . DelegationConfigureRestakeEarnings
+        forM_ duCapital $ \newCap ->
+            if newCap >= oldCapital
+                then tell [DelegationConfigureStakeIncreased newCap]
+                else tell [DelegationConfigureStakeReduced newCap]
+
+testUpdateDelegator ::
+    forall pv.
+    ( IsProtocolVersion pv,
+      SupportsDelegation (AccountVersionFor pv) ~ 'True,
+      PoolParametersVersionFor (ChainParametersVersionFor pv) ~ 'PoolParametersVersion1
+    ) =>
+    SProtocolVersion pv ->
+    Property
+testUpdateDelegator spv = withMaxSuccess 1000 $ property $ do
+    accounts <- genTestAccounts @(AccountVersionFor pv)
+    useAccount <- elements [acc | acc <- accounts, isDelegator acc]
+    capital <-
+        frequency
+            [ (8, Just . (baseStake *) . fromInteger <$> choose (1, 20)),
+              (4, Just . fromInteger <$> choose (1, fromIntegral baseAmount)),
+              (2, return Nothing),
+              (1, return $ Just 0)
+            ]
+    restake <- arbitrary
+    let chooseNonBaker = elements [DelegateToBaker (BakerId (acAccountIndex acc)) | acc <- accounts, not (isBaker acc)]
+    let chooseBaker = elements [DelegateToBaker (BakerId (acAccountIndex acc)) | acc <- accounts, isBaker acc]
+    let chooseInvalidAccount = elements [DelegateToBaker (BakerId (fromIntegral i)) | i <- [length accounts .. length accounts + 10]]
+    target <-
+        frequency
+            [ (1, return $ Just DelegatePassive),
+              (1, Just <$> chooseNonBaker),
+              (8, Just <$> chooseBaker),
+              (1, return Nothing),
+              (1, Just <$> chooseInvalidAccount)
+            ]
+    let delegatorUpdate =
+            DelegatorUpdate
+                { duCapital = capital,
+                  duRestakeEarnings = restake,
+                  duDelegationTarget = target
+                }
+    capitalBound <- CapitalBound . AmountFraction . fromInteger <$> choose (1, 100_000)
+    leverageDen <- choose (1, 10)
+    leverageNum <- choose (leverageDen, 100)
+    let leverageBound = LeverageFactor $ leverageNum % leverageDen
+    let config =
+            DelegatorTestConfig
+                { dtcAccounts = accounts,
+                  dtcUseAccount = acAccountIndex useAccount,
+                  dtcCapitalBound = capitalBound,
+                  dtcLeverageBound = leverageBound
+                }
+    let lab
+            | target == Just DelegatePassive = "Passive delegation"
+            | otherwise = showExpectedResult $ expectedUpdateResult config delegatorUpdate
+    return $
+        label lab $
+            counterexample (show config) $
+                counterexample (show delegatorUpdate) $
+                    ioProperty $
+                        runUpdateDelegatorTest spv config delegatorUpdate
+  where
+    isDelegator AccountConfig{acStaking = StakeDetailsDelegator{}} = True
+    isDelegator _ = False
+    isBaker AccountConfig{acStaking = StakeDetailsBaker{}} = True
+    isBaker _ = False
+
+tests :: Spec
+tests = parallel $ describe "Configure delegator" $ do
+    describe "P6" $ do
+        it "bsoAddDelegator" $ testAddDelegator SP6
+        it "bsoUpdateDelegator" $ testUpdateDelegator SP6
+    describe "P7" $ do
+        it "bsoAddDelegator" $ testAddDelegator SP7
+        it "bsoUpdateDelegator" $ testUpdateDelegator SP7
diff --git a/concordium-consensus/tests/globalstate/GlobalStateTests/ConfigureValidator.hs b/concordium-consensus/tests/globalstate/GlobalStateTests/ConfigureValidator.hs
index 28fea3804..3fa2020e0 100644
--- a/concordium-consensus/tests/globalstate/GlobalStateTests/ConfigureValidator.hs
+++ b/concordium-consensus/tests/globalstate/GlobalStateTests/ConfigureValidator.hs
@@ -42,36 +42,6 @@ import qualified Concordium.GlobalState.Persistent.Trie as Trie
 
 import GlobalStateTests.BlockStateHelpers
 
--- | Representation of the active bakers in the block state.
-data ActiveBakers = ActiveBakers
-    { abActiveBakers :: Map.Map BakerId ([DelegatorId], Amount),
-      abAggregationKeys :: [BakerAggregationVerifyKey],
-      abPassiveDelegators :: ([DelegatorId], Amount),
-      abTotalActiveCapital :: Amount
-    }
-    deriving (Eq, Show)
-
--- | Load the active bakers from the block state.
--- Note, 'abTotalActiveCapital' will be 0 if the block state is from a version that does not store
--- this value.
-loadActiveBakers :: forall av m. (MonadBlobStore m, IsAccountVersion av) => BufferedRef (PersistentActiveBakers av) -> m ActiveBakers
-loadActiveBakers pabRef = do
-    PersistentActiveBakers{..} <- refLoad pabRef
-    bakers0 <- Trie.toMap _activeBakers
-    abActiveBakers <- mapM loadActiveDelegators bakers0
-    abAggregationKeys <- Map.keys <$> Trie.toMap _aggregationKeys
-    abPassiveDelegators <- loadActiveDelegators _passiveDelegators
-    let abTotalActiveCapital = case _totalActiveCapital of
-            TotalActiveCapitalV0 -> 0
-            TotalActiveCapitalV1 capital -> capital
-    return ActiveBakers{..}
-  where
-    loadActiveDelegators :: PersistentActiveDelegators av -> m ([DelegatorId], Amount)
-    loadActiveDelegators PersistentActiveDelegatorsV0 = return ([], 0)
-    loadActiveDelegators (PersistentActiveDelegatorsV1 delegators capital) = do
-        dlgs <- Trie.keysAsc delegators
-        return (dlgs, capital)
-
 -- | Test accounts used for testing the 'bsoAddValidator' function.
 --  The first account is a regular account, the second account is a baker account.
 addValidatorTestAccounts ::
@@ -83,6 +53,7 @@ addValidatorTestAccounts withCooldowns =
         { acAccountIndex = 0,
           acAmount = 1_000_000_000_000,
           acStaking = StakeDetailsNone,
+          acPoolInfo = Nothing,
           acCooldowns = if withCooldowns then initialTestCooldowns else emptyCooldowns
         },
       AccountConfig
@@ -94,6 +65,7 @@ addValidatorTestAccounts withCooldowns =
                   sdRestakeEarnings = True,
                   sdPendingChange = NoChange
                 },
+          acPoolInfo = Nothing,
           acCooldowns = emptyCooldowns
         }
     ]
@@ -143,10 +115,6 @@ testAddValidatorAllCases spv = describe "bsoAddValidator" $ do
         when supportCooldown $ it (show vc <> " with cooldown") $ runTest True vc
   where
     supportCooldown = supportsFlexibleCooldown $ accountVersionFor $ demoteProtocolVersion (protocolVersion @pv)
-    seedState :: SeedState (SeedStateVersionFor pv)
-    seedState = case sSeedStateVersionFor (protocolVersion @pv) of
-        SSeedStateVersion0 -> initialSeedStateV0 (Hash.hash "NONCE") 1000
-        SSeedStateVersion1 -> initialSeedStateV1 (Hash.hash "NONCE") 1000
     minEquity = 1_000_000_000
     chainParams =
         DummyData.dummyChainParameters @(ChainParametersVersionFor pv)
@@ -160,7 +128,7 @@ testAddValidatorAllCases spv = describe "bsoAddValidator" $ do
     mkInitialState accounts =
         hpbsPointers
             <$> initialPersistentState @pv
-                seedState
+                (dummySeedState (protocolVersion @pv))
                 DummyData.dummyCryptographicParameters
                 accounts
                 DummyData.dummyIdentityProviders
@@ -194,15 +162,8 @@ testAddValidatorAllCases spv = describe "bsoAddValidator" $ do
                 | otherwise = Right ()
         liftIO $ void res `shouldBe` expect
         forM_ res $ \bs -> do
-            -- To check that the active stake indexes are updated correctly, we construct a new
-            -- block state using the current state of the accounts (which will build the indexes
-            -- anew) and check that the indexes match.
-            bsp <- loadPBS bs
-            theAccounts <- Accounts.foldAccountsDesc (\l a -> pure (a : l)) [] (bspAccounts bsp)
-            newBSP <- loadPBS =<< mkInitialState theAccounts
-            expectedActiveBakers <- loadActiveBakers (_birkActiveBakers $ bspBirkParameters newBSP)
-            actualActiveBakers <- loadActiveBakers (_birkActiveBakers $ bspBirkParameters bsp)
-            liftIO $ actualActiveBakers `shouldBe` expectedActiveBakers
+            -- Check the active bakers are correct
+            checkActiveBakers bs
             () <- case sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv)) of
                 STrue -> do
                     -- Check that the cooldowns are correct
@@ -272,6 +233,7 @@ updateValidatorTestAccounts pendingChangeOrCooldown =
                   sdRestakeEarnings = True,
                   sdPendingChange = pendingChange
                 },
+          acPoolInfo = Nothing,
           acCooldowns = cooldowns
         },
       AccountConfig
@@ -283,6 +245,7 @@ updateValidatorTestAccounts pendingChangeOrCooldown =
                   sdRestakeEarnings = True,
                   sdPendingChange = NoChange
                 },
+          acPoolInfo = Nothing,
           acCooldowns = emptyCooldowns
         },
       AccountConfig
@@ -295,6 +258,7 @@ updateValidatorTestAccounts pendingChangeOrCooldown =
                   sdPendingChange = NoChange,
                   sdDelegationTarget = DelegateToBaker 0
                 },
+          acPoolInfo = Nothing,
           acCooldowns = emptyCooldowns
         }
     ]
@@ -527,15 +491,8 @@ runUpdateValidatorTest spv commissionRanges ValidatorUpdateConfig{vucValidatorUp
                             then [BakerConfigureStakeIncreased capital]
                             else [BakerConfigureStakeReduced capital]
         liftIO $ changes `shouldBe` expectChanges
-        -- To check that the active stake indexes are updated correctly, we construct a new
-        -- block state using the current state of the accounts (which will build the indexes
-        -- anew) and check that the indexes match.
-        bsp <- loadPBS bs
-        theAccounts <- Accounts.foldAccountsDesc (\l a -> pure (a : l)) [] (bspAccounts bsp)
-        newBSP <- loadPBS =<< mkInitialState theAccounts
-        expectedActiveBakers <- loadActiveBakers (_birkActiveBakers $ bspBirkParameters newBSP)
-        actualActiveBakers <- loadActiveBakers (_birkActiveBakers $ bspBirkParameters bsp)
-        liftIO $ actualActiveBakers `shouldBe` expectedActiveBakers
+        -- Check the active bakers are correct
+        checkActiveBakers bs
         () <- case flexibleCooldown of
             STrue -> do
                 -- Check that the cooldowns are correct
@@ -590,10 +547,6 @@ runUpdateValidatorTest spv commissionRanges ValidatorUpdateConfig{vucValidatorUp
         liftIO $ actualAccountBaker `shouldBe` expectedAccountBaker
   where
     flexibleCooldown = sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv))
-    seedState :: SeedState (SeedStateVersionFor pv)
-    seedState = case sSeedStateVersionFor (protocolVersion @pv) of
-        SSeedStateVersion0 -> initialSeedStateV0 (Hash.hash "NONCE") 1000
-        SSeedStateVersion1 -> initialSeedStateV1 (Hash.hash "NONCE") 1000
     minEquity = 1_000_000_000
     chainParams =
         DummyData.dummyChainParameters @(ChainParametersVersionFor pv)
@@ -603,7 +556,7 @@ runUpdateValidatorTest spv commissionRanges ValidatorUpdateConfig{vucValidatorUp
     mkInitialState accounts =
         hpbsPointers
             <$> initialPersistentState @pv
-                seedState
+                (dummySeedState (protocolVersion @pv))
                 DummyData.dummyCryptographicParameters
                 accounts
                 DummyData.dummyIdentityProviders
diff --git a/concordium-consensus/tests/globalstate/Spec.hs b/concordium-consensus/tests/globalstate/Spec.hs
index a15f345fa..a1f44a0c7 100644
--- a/concordium-consensus/tests/globalstate/Spec.hs
+++ b/concordium-consensus/tests/globalstate/Spec.hs
@@ -10,6 +10,7 @@ import qualified GlobalStateTests.AccountsMigrationP6ToP7 (tests)
 import qualified GlobalStateTests.BlobStore (tests)
 import qualified GlobalStateTests.BlockHash (tests)
 import qualified GlobalStateTests.Cache (tests)
+import qualified GlobalStateTests.ConfigureDelegator (tests)
 import qualified GlobalStateTests.ConfigureValidator (tests)
 import qualified GlobalStateTests.CooldownProcessing (tests)
 import qualified GlobalStateTests.CooldownQueue (tests)
@@ -59,3 +60,4 @@ main = atLevel $ \lvl -> hspec $ do
     GlobalStateTests.CooldownQueue.tests
     GlobalStateTests.CooldownProcessing.tests
     GlobalStateTests.ConfigureValidator.tests lvl
+    GlobalStateTests.ConfigureDelegator.tests

From c82c6e7dbcfd0ce90163f9504d94433e24cbab77 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Mon, 12 Aug 2024 12:42:36 +0200
Subject: [PATCH 56/81] Update delegator: fix corner case behaviours, tests and
 documentation.

---
 .../src/Concordium/GlobalState/BlockState.hs  | 42 ++++++++++++++-----
 .../GlobalState/Persistent/BlockState.hs      | 19 +++++----
 .../GlobalStateTests/ConfigureDelegator.hs    | 13 +++---
 3 files changed, 50 insertions(+), 24 deletions(-)

diff --git a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs
index 801a3e8c0..e4ad75b6b 100644
--- a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs
@@ -1101,7 +1101,9 @@ class (BlockStateQuery m) => BlockStateOperations m where
     --       * if the capital is greater than the baker's current equity capital, increase the baker's
     --         equity capital to the new capital (updating the total active capital in the active baker
     --         index by adding the difference between the new and old capital) and append
-    --         @BakerConfigureStakeIncreased capital@ to @events@.
+    --         @BakerConfigureStakeIncreased capital@ to @events@. From P7, the increase in stake
+    --         is (preferentially) reactivated from the inactive stake, updating the global indices
+    --         accordingly.
     --
     --  8. Return @events@ with the updated block state.
     bsoUpdateValidator ::
@@ -1175,7 +1177,9 @@ class (BlockStateQuery m) => BlockStateOperations m where
     --
     --  1. If the delegation target is specified as @target@:
     --
-    --       (1) If the delegation target is a valid baker that is not 'OpenForAll', return 'DCFPoolClosed'.
+    --       (1) If the delegation target is changed and is a valid baker that is not 'OpenForAll',
+    --           return 'DCFPoolClosed'. [Note, it is allowed for the target to be the same baker,
+    --           which is 'ClosedForNew'.]
     --
     --       (2) If the delegation target is baker id @bid@, but the baker does not exist, return
     --           @DCFInvalidDelegationTarget bid@.
@@ -1200,14 +1204,26 @@ class (BlockStateQuery m) => BlockStateOperations m where
     --  3. If the delegated capital is specified as @capital@: if there is a pending change to the
     --     delegator's stake, return 'DCFChangePending'; otherwise:
     --
-    --       * If the new capital is 0, mark the delegator as pending removal at the slot timestamp
-    --         plus the delegator cooldown chain parameter, and append
-    --         @DelegationConfigureStakeReduced capital@ to @events@; otherwise
+    --       * If the new capital is 0
     --
-    --       * If the the new capital is less than the current staked capital (but not 0), mark the
-    --         delegator as pending stake reduction to @capital@ at the slot timestamp plus the
-    --         delegator cooldown chain parameter, and append @DelegationConfigureStakeReduced capital@
-    --         to @events@;
+    --           - (< P7) mark the delegator as pending removal at the slot timestamp
+    --             plus the delegator cooldown chain parameter
+    --
+    --           - (>= P7) remove the delegation record from the account, transfer the existing
+    --             staked capital to pre-pre-cooldown, and mark the account as in pre-pre-cooldown
+    --             (in the global index) if it wasn't already
+    --
+    --           - append @DelegationConfigureStakeReduced capital@ to @events@;
+    --
+    --       * If the the new capital is less than the current staked capital (but not 0),
+    --
+    --           - (< P7) mark the delegator as pending stake reduction to @capital@ at the slot
+    --             timestamp plus the delegator cooldown chain parameter
+    --
+    --           - (>= P7) transfer the decrease in staked capital to pre-pre-cooldown, and mark the
+    --             account as in pre-pre-cooldown (in the global index) if it wasn't already
+    --
+    --           - append @DelegationConfigureStakeReduced capital@ to @events@;
     --
     --       * If the new capital is equal to the current staked capital, append
     --         @DelegationConfigureStakeIncreased capital@ to @events@.
@@ -1218,11 +1234,15 @@ class (BlockStateQuery m) => BlockStateOperations m where
     --
     --             * increase the delegator's target pool delegated capital by @delta@,
     --
-    --             * set the baker's delegated capital to @capital@, and
+    --             * set the account's delegated capital to @capital@,
+    --
+    --             * (>= P7) reactivate @delta@ from the account's inactive stake, removing the
+    --               account from the global cooldown indices if necessary,
     --
     --             * append @DelegationConfigureStakeIncreased capital@ to @events@.
     --
-    --  4. If the delegation target has changed or the delegated capital is increased:
+    --  4. If the delegation target has changed (and the delegation was not immediately removed) or
+    --     the delegated capital is increased:
     --
     --            * If the amount delegated to the delegation target exceeds the leverage bound,
     --              return 'DCFPoolStakeOverThreshold' and revert any changes.
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
index 966f5e977..917b5c66d 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
@@ -2174,8 +2174,8 @@ newAddDelegator pbs ai da@DelegatorAdd{..} = do
 --  1. If the delegation target is neither passive nor a valid baker, throw
 --     'DCFInvalidDelegationTarget'.
 --
---  2. If the delegation target is a valid baker, but the pool is not open for all, throw
---     'DCFPoolClosed'.
+--  2. If the delegation target is a valid baker that is different from the previous target, but
+--     the pool is not open for all, throw 'DCFPoolClosed'.
 --
 --  3. If the delegated capital is specified and there is a pending change to the delegator's
 --     stake, throw 'DCFChangePending'.
@@ -2218,11 +2218,14 @@ updateDelegatorChecks bsp oldDelegator DelegatorUpdate{..} = do
             onAccount baid bsp accountBaker >>= \case
                 Nothing -> MTL.throwError (DCFInvalidDelegationTarget bid)
                 Just baker -> do
-                    unless (baker ^. BaseAccounts.poolOpenStatus == Transactions.OpenForAll) $
-                        MTL.throwError DCFPoolClosed
                     let sameBaker =
                             Transactions.DelegateToBaker bid
                                 == oldDelegator ^. BaseAccounts.delegationTarget
+                    unless
+                        ( sameBaker
+                            || baker ^. BaseAccounts.poolOpenStatus == Transactions.OpenForAll
+                        )
+                        $ MTL.throwError DCFPoolClosed
                     return $ Just (baker, sameBaker)
     -- If the capital is being changed, check there is not a pending change.
     let hasPendingChange =
@@ -2242,8 +2245,8 @@ updateDelegatorChecks bsp oldDelegator DelegatorUpdate{..} = do
                     SFalse -> max newStake oldStake -- If the stake is reduced, the change is pending.
                     STrue -> newStake
         -- We only check for over-delegation if the stake is being increased or the target is
-        -- is changed.
-        unless (sameBaker && newEffectiveStake <= oldStake) $ do
+        -- is changed and the effective stake is non-zero.
+        unless (newEffectiveStake == 0 || sameBaker && newEffectiveStake <= oldStake) $ do
             -- The change to the total staked capital.
             let delta = newEffectiveStake `amountDiff` oldStake
             -- The change to the pool's staked capital. This depends on whether the delegator is
@@ -2274,7 +2277,9 @@ updateDelegatorChecks bsp oldDelegator DelegatorUpdate{..} = do
 --
 --  1. If the delegation target is specified as @target@:
 --
---       (1) If the delegation target is a valid baker that is not 'OpenForAll', return 'DCFPoolClosed'.
+--       (1) If the delegation target is changed and is a valid baker that is not 'OpenForAll',
+--           return 'DCFPoolClosed'. [Note, it is allowed for the target to be the same baker,
+--           which is 'ClosedForNew'.]
 --
 --       (2) If the delegation target is baker id @bid@, but the baker does not exist, return
 --           @DCFInvalidDelegationTarget bid@.
diff --git a/concordium-consensus/tests/globalstate/GlobalStateTests/ConfigureDelegator.hs b/concordium-consensus/tests/globalstate/GlobalStateTests/ConfigureDelegator.hs
index a96b0f3df..c33c6dfe2 100644
--- a/concordium-consensus/tests/globalstate/GlobalStateTests/ConfigureDelegator.hs
+++ b/concordium-consensus/tests/globalstate/GlobalStateTests/ConfigureDelegator.hs
@@ -167,6 +167,7 @@ expectedAddResult dtc@DelegatorTestConfig{..} DelegatorAdd{..}
 expectedUpdateResult :: forall av. (IsAccountVersion av) => DelegatorTestConfig av -> DelegatorUpdate -> Either DelegatorConfigureFailure ()
 expectedUpdateResult dtc@DelegatorTestConfig{..} DelegatorUpdate{..}
     | Just t <- duDelegationTarget,
+      oldTarget /= t,
       Just False <- dtcTargetOpen dtc t =
         Left DCFPoolClosed
     | Just t@(DelegateToBaker bid) <- duDelegationTarget,
@@ -174,8 +175,8 @@ expectedUpdateResult dtc@DelegatorTestConfig{..} DelegatorUpdate{..}
         Left $ DCFInvalidDelegationTarget bid
     | Just _ <- duCapital, changePending = Left DCFChangePending
     | DelegateToBaker bid <- newTarget,
-      oldTarget /= newTarget || oldCapital < newCapital,
-      -- not flexibleCooldown || newCapital > 0 || oldTarget /= newTarget,
+      newEffectiveCapital > 0,
+      oldTarget /= newTarget || oldCapital < newEffectiveCapital,
       Just (bkrStake, delStake) <- dtcBakerStake dtc bid =
         if
             | applyAmountDelta deltaPool (delStake + bkrStake)
@@ -196,16 +197,16 @@ expectedUpdateResult dtc@DelegatorTestConfig{..} DelegatorUpdate{..}
     (oldCapital, oldTarget, changePending) = case acStaking senderAccount of
         StakeDetailsDelegator{..} -> (sdStakedCapital, sdDelegationTarget, sdPendingChange /= NoChange)
         _ -> error "Account is not a delegator"
-    delta = maybe 0 (`amountDiff` oldCapital) duCapital
-    newCapital
+    newEffectiveCapital
         | not flexibleCooldown,
           Just newCap <- duCapital,
           newCap < oldCapital =
             oldCapital
         | otherwise = fromMaybe oldCapital duCapital
+    delta = amountDiff newEffectiveCapital oldCapital
     deltaPool
-        | Just t <- duDelegationTarget, t /= oldTarget = amountToDelta newCapital
-        | otherwise = amountDiff newCapital oldCapital
+        | Just t <- duDelegationTarget, t /= oldTarget = amountToDelta newEffectiveCapital
+        | otherwise = delta
     newTarget = fromMaybe oldTarget duDelegationTarget
 
 showExpectedResult :: Either DelegatorConfigureFailure () -> String

From 9cda84df9703ad4b76b84f17908b0f2c9e404d08 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Mon, 12 Aug 2024 16:35:12 +0200
Subject: [PATCH 57/81] Documentation

---
 CHANGELOG.md                                  |   3 +
 .../GlobalStateTests/ConfigureDelegator.hs    | 201 +++++++++++-------
 .../GlobalStateTests/ConfigureValidator.hs    |   6 -
 3 files changed, 125 insertions(+), 85 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 8415888a0..e339c9fe9 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -27,6 +27,9 @@
   - Changes to validators and delegators can be made while stake is in cooldown,
     including changing the stake, or changing directly between validator and
     delegator.
+- Fix a bug where a configure-validator transaction that is rejected for having
+  a duplicate aggregation key would report the old key for the validator,
+  rather than the key that is a duplicate.
 
 ## 6.3.1
 
diff --git a/concordium-consensus/tests/globalstate/GlobalStateTests/ConfigureDelegator.hs b/concordium-consensus/tests/globalstate/GlobalStateTests/ConfigureDelegator.hs
index c33c6dfe2..4c15c3eca 100644
--- a/concordium-consensus/tests/globalstate/GlobalStateTests/ConfigureDelegator.hs
+++ b/concordium-consensus/tests/globalstate/GlobalStateTests/ConfigureDelegator.hs
@@ -6,19 +6,9 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 
+-- | Tests for adding and updating delegators.
 module GlobalStateTests.ConfigureDelegator where
 
-import Concordium.GlobalState.Account
-import Concordium.GlobalState.BakerInfo
-import Concordium.GlobalState.BlockState
-import Concordium.GlobalState.CooldownQueue
-import qualified Concordium.GlobalState.DummyData as DummyData
-import Concordium.GlobalState.Persistent.BlockState
-import Concordium.Types
-import Concordium.Types.Accounts
-import Concordium.Types.Execution
-import Concordium.Types.Option
-import Concordium.Types.Parameters
 import Control.Monad
 import Control.Monad.IO.Class
 import Control.Monad.Writer.CPS
@@ -31,6 +21,19 @@ import Lens.Micro.Platform
 import Test.Hspec
 import Test.QuickCheck
 
+import Concordium.Types
+import Concordium.Types.Accounts
+import Concordium.Types.Execution
+import Concordium.Types.Option
+import Concordium.Types.Parameters
+
+import Concordium.GlobalState.Account
+import Concordium.GlobalState.BakerInfo
+import Concordium.GlobalState.BlockState
+import Concordium.GlobalState.CooldownQueue
+import qualified Concordium.GlobalState.DummyData as DummyData
+import Concordium.GlobalState.Persistent.BlockState
+
 -- | Some non-trivial cooldowns that may be set on an account for testing.
 initialTestCooldowns :: Cooldowns
 initialTestCooldowns =
@@ -40,9 +43,12 @@ initialTestCooldowns =
           preCooldown = Present 2
         }
 
+-- | The balance for accounts used in the tests.
 baseAmount :: Amount
 baseAmount = 100
 
+-- | The baseline stake used in the tests. The test account use (small) multiples of this amount.
+--  Setting this to 1 makes it easier to catch off-by-one errors in the tests.
 baseStake :: Amount
 baseStake = 1
 
@@ -57,9 +63,17 @@ genTestAccounts = do
     nDelegators <- choose (1, nAccounts - nBakers - 1)
     let nonBakers = filter (`notElem` bakerIndices) accountIndices
     delegatorIndices <- take nDelegators <$> shuffle nonBakers
-    bakerStatuses <- vectorOf nAccounts (frequency [(8, return OpenForAll), (1, return ClosedForAll), (1, return ClosedForNew)])
+    -- Favour open pools to ensure the case of delegating to a closed pool is not overrepresented.
+    bakerStatuses <-
+        vectorOf nAccounts $
+            frequency
+                [ (8, return OpenForAll),
+                  (1, return ClosedForAll),
+                  (1, return ClosedForNew)
+                ]
     forM accountIndices $ \ai -> do
         stake <- (baseStake *) . fromInteger <$> choose (1, 10)
+        -- Delegators can only delegate to pools that are not closed for all.
         delTarget <-
             elements $
                 DelegatePassive
@@ -100,10 +114,16 @@ genTestAccounts = do
                   acCooldowns = cooldowns
                 }
 
+-- | A configuration for testing the delegator functionality.
 data DelegatorTestConfig av = DelegatorTestConfig
-    { dtcAccounts :: [AccountConfig av],
+    { -- | The configuration of account to use. These must be sequentially indexed.
+      dtcAccounts :: [AccountConfig av],
+      -- | The index of the account to use in a test. It must be present in 'dtcAccounts', and
+      --  other conditions may apply depending on the test.
       dtcUseAccount :: AccountIndex,
+      -- | The capital bound to use in the test.
       dtcCapitalBound :: CapitalBound,
+      -- | The leverage bound to use in the test.
       dtcLeverageBound :: LeverageFactor
     }
     deriving (Show)
@@ -122,6 +142,7 @@ dtcTargetOpen DelegatorTestConfig{..} (DelegateToBaker bi)
             _ -> Nothing
     | otherwise = Nothing
 
+-- | The total active stake of bakers and delegators in the configuration.
 dtcTotalStake :: DelegatorTestConfig av -> Amount
 dtcTotalStake DelegatorTestConfig{..} =
     sum $ map (accountStakedCapital . acStaking) dtcAccounts
@@ -130,6 +151,8 @@ dtcTotalStake DelegatorTestConfig{..} =
     accountStakedCapital StakeDetailsDelegator{..} = sdStakedCapital
     accountStakedCapital _ = 0
 
+-- | Get the total active stake and delegated stake of a baker. (Or 'Nothing' if the baker does
+-- not exist as an active baker.)
 dtcBakerStake :: DelegatorTestConfig av -> BakerId -> Maybe (Amount, Amount)
 dtcBakerStake DelegatorTestConfig{..} bi = (,delegatorStakes) <$> bkrStake
   where
@@ -143,9 +166,20 @@ dtcBakerStake DelegatorTestConfig{..} bi = (,delegatorStakes) <$> bkrStake
         | sdDelegationTarget == DelegateToBaker bi = sdStakedCapital
     delStake _ = 0
 
+-- | The cooldowns for the accounts in the configuration.
 dtcCooldowns :: DelegatorTestConfig av -> [Cooldowns]
 dtcCooldowns DelegatorTestConfig{..} = map acCooldowns dtcAccounts
 
+-- | Show the expected result of a test. This is used for labelling test cases.
+showExpectedResult :: Either DelegatorConfigureFailure a -> String
+showExpectedResult (Left DCFInvalidDelegationTarget{}) = "DCFInvalidDelegationTarget"
+showExpectedResult (Left DCFPoolClosed) = "DCFPoolClosed"
+showExpectedResult (Left DCFPoolStakeOverThreshold) = "DCFPoolStakeOverThreshold"
+showExpectedResult (Left DCFPoolOverDelegated) = "DCFPoolOverDelegated"
+showExpectedResult (Left DCFChangePending) = "DCFChangePending"
+showExpectedResult (Right _) = "Success"
+
+-- | Get the expected result of adding a delegator.
 expectedAddResult :: DelegatorTestConfig av -> DelegatorAdd -> Either DelegatorConfigureFailure ()
 expectedAddResult dtc@DelegatorTestConfig{..} DelegatorAdd{..}
     | Just False <- targetOpen = Left DCFPoolClosed
@@ -164,59 +198,9 @@ expectedAddResult dtc@DelegatorTestConfig{..} DelegatorAdd{..}
   where
     targetOpen = dtcTargetOpen dtc daDelegationTarget
 
-expectedUpdateResult :: forall av. (IsAccountVersion av) => DelegatorTestConfig av -> DelegatorUpdate -> Either DelegatorConfigureFailure ()
-expectedUpdateResult dtc@DelegatorTestConfig{..} DelegatorUpdate{..}
-    | Just t <- duDelegationTarget,
-      oldTarget /= t,
-      Just False <- dtcTargetOpen dtc t =
-        Left DCFPoolClosed
-    | Just t@(DelegateToBaker bid) <- duDelegationTarget,
-      Nothing <- dtcTargetOpen dtc t =
-        Left $ DCFInvalidDelegationTarget bid
-    | Just _ <- duCapital, changePending = Left DCFChangePending
-    | DelegateToBaker bid <- newTarget,
-      newEffectiveCapital > 0,
-      oldTarget /= newTarget || oldCapital < newEffectiveCapital,
-      Just (bkrStake, delStake) <- dtcBakerStake dtc bid =
-        if
-            | applyAmountDelta deltaPool (delStake + bkrStake)
-                > applyLeverageFactor dtcLeverageBound bkrStake ->
-                Left DCFPoolStakeOverThreshold
-            | applyAmountDelta deltaPool (bkrStake + delStake)
-                > takeFraction
-                    (theCapitalBound dtcCapitalBound)
-                    (applyAmountDelta delta $ dtcTotalStake dtc) ->
-                Left DCFPoolOverDelegated
-            | otherwise -> Right ()
-    | otherwise = Right ()
-  where
-    flexibleCooldown = case sSupportsFlexibleCooldown (accountVersion @av) of
-        STrue -> True
-        SFalse -> False
-    senderAccount = dtcAccounts !! fromIntegral dtcUseAccount
-    (oldCapital, oldTarget, changePending) = case acStaking senderAccount of
-        StakeDetailsDelegator{..} -> (sdStakedCapital, sdDelegationTarget, sdPendingChange /= NoChange)
-        _ -> error "Account is not a delegator"
-    newEffectiveCapital
-        | not flexibleCooldown,
-          Just newCap <- duCapital,
-          newCap < oldCapital =
-            oldCapital
-        | otherwise = fromMaybe oldCapital duCapital
-    delta = amountDiff newEffectiveCapital oldCapital
-    deltaPool
-        | Just t <- duDelegationTarget, t /= oldTarget = amountToDelta newEffectiveCapital
-        | otherwise = delta
-    newTarget = fromMaybe oldTarget duDelegationTarget
-
-showExpectedResult :: Either DelegatorConfigureFailure () -> String
-showExpectedResult (Left DCFInvalidDelegationTarget{}) = "DCFInvalidDelegationTarget"
-showExpectedResult (Left DCFPoolClosed) = "DCFPoolClosed"
-showExpectedResult (Left DCFPoolStakeOverThreshold) = "DCFPoolStakeOverThreshold"
-showExpectedResult (Left DCFPoolOverDelegated) = "DCFPoolOverDelegated"
-showExpectedResult (Left DCFChangePending) = "DCFChangePending"
-showExpectedResult (Right _) = "Success"
-
+-- | Run a test of 'bsoAddDelegator' with the given configuration and delegator to add.
+--  In the configuration, 'dtcUseAccount' must be the index of an account that is neither a baker
+--  nor a delegator.
 runAddDelegatorTest ::
     forall pv.
     ( IsProtocolVersion pv,
@@ -272,6 +256,7 @@ runAddDelegatorTest spv dtc@DelegatorTestConfig{..} da@DelegatorAdd{..} = runTes
                 (withIsAuthorizationsVersionForPV spv DummyData.dummyKeyCollection)
                 chainParams
 
+-- | Test 'bsoAddDelegator' with a random configurations.
 testAddDelegator ::
     forall pv.
     ( IsProtocolVersion pv,
@@ -289,9 +274,15 @@ testAddDelegator spv = withMaxSuccess 1000 $ property $ do
               fromInteger <$> choose (1, fromIntegral baseAmount)
             ]
     restake <- arbitrary
-    let chooseNonBaker = elements [DelegateToBaker (BakerId (acAccountIndex acc)) | acc <- accounts, not (isBaker acc)]
-    let chooseBaker = elements [DelegateToBaker (BakerId (acAccountIndex acc)) | acc <- accounts, isBaker acc]
-    let chooseInvalidAccount = elements [DelegateToBaker (BakerId (fromIntegral i)) | i <- [length accounts .. length accounts + 10]]
+    let delegateToAccount acc = DelegateToBaker (BakerId (acAccountIndex acc))
+    let chooseNonBaker = elements [delegateToAccount acc | acc <- accounts, not (isBaker acc)]
+    let chooseBaker = elements [delegateToAccount acc | acc <- accounts, isBaker acc]
+    let chooseInvalidAccount =
+            elements
+                [ DelegateToBaker (BakerId (fromIntegral i))
+                  | i <- [length accounts .. length accounts + 10]
+                ]
+    -- Favour delegating to a baker, as this covers the most interesting cases.
     target <-
         frequency
             [ (1, return DelegatePassive),
@@ -331,6 +322,65 @@ testAddDelegator spv = withMaxSuccess 1000 $ property $ do
     isBaker AccountConfig{acStaking = StakeDetailsBaker{}} = True
     isBaker _ = False
 
+-- | Get the expected result of updating a delegator.
+expectedUpdateResult ::
+    forall av.
+    (IsAccountVersion av) =>
+    DelegatorTestConfig av ->
+    DelegatorUpdate ->
+    Either DelegatorConfigureFailure [DelegationConfigureUpdateChange]
+expectedUpdateResult dtc@DelegatorTestConfig{..} DelegatorUpdate{..}
+    | Just t <- duDelegationTarget,
+      oldTarget /= t,
+      Just False <- dtcTargetOpen dtc t =
+        Left DCFPoolClosed
+    | Just t@(DelegateToBaker bid) <- duDelegationTarget,
+      Nothing <- dtcTargetOpen dtc t =
+        Left $ DCFInvalidDelegationTarget bid
+    | Just _ <- duCapital, changePending = Left DCFChangePending
+    | DelegateToBaker bid <- newTarget,
+      newEffectiveCapital > 0,
+      oldTarget /= newTarget || oldCapital < newEffectiveCapital,
+      Just (bkrStake, delStake) <- dtcBakerStake dtc bid =
+        if
+            | applyAmountDelta deltaPool (delStake + bkrStake)
+                > applyLeverageFactor dtcLeverageBound bkrStake ->
+                Left DCFPoolStakeOverThreshold
+            | applyAmountDelta deltaPool (bkrStake + delStake)
+                > takeFraction
+                    (theCapitalBound dtcCapitalBound)
+                    (applyAmountDelta delta $ dtcTotalStake dtc) ->
+                Left DCFPoolOverDelegated
+            | otherwise -> Right expectChanges
+    | otherwise = Right expectChanges
+  where
+    flexibleCooldown = case sSupportsFlexibleCooldown (accountVersion @av) of
+        STrue -> True
+        SFalse -> False
+    senderAccount = dtcAccounts !! fromIntegral dtcUseAccount
+    (oldCapital, oldTarget, changePending) = case acStaking senderAccount of
+        StakeDetailsDelegator{..} -> (sdStakedCapital, sdDelegationTarget, sdPendingChange /= NoChange)
+        _ -> error "Account is not a delegator"
+    newEffectiveCapital
+        | not flexibleCooldown,
+          Just newCap <- duCapital,
+          newCap < oldCapital =
+            oldCapital
+        | otherwise = fromMaybe oldCapital duCapital
+    delta = amountDiff newEffectiveCapital oldCapital
+    deltaPool
+        | Just t <- duDelegationTarget, t /= oldTarget = amountToDelta newEffectiveCapital
+        | otherwise = delta
+    newTarget = fromMaybe oldTarget duDelegationTarget
+    expectChanges = execWriter $ do
+        forM_ duDelegationTarget $ tell . (: []) . DelegationConfigureDelegationTarget
+        forM_ duRestakeEarnings $ tell . (: []) . DelegationConfigureRestakeEarnings
+        forM_ duCapital $ \newCap ->
+            if newCap >= oldCapital
+                then tell [DelegationConfigureStakeIncreased newCap]
+                else tell [DelegationConfigureStakeReduced newCap]
+
+-- | Run a test of 'bsoUpdateDelegator' with the given configuration and delegator update.
 runUpdateDelegatorTest ::
     forall pv.
     ( IsProtocolVersion pv,
@@ -346,9 +396,8 @@ runUpdateDelegatorTest spv dtc@DelegatorTestConfig{..} du@DelegatorUpdate{..} =
     initialBS <- mkInitialState initialAccounts
     res <- bsoUpdateDelegator initialBS 5000 dtcUseAccount du
     let expect = expectedUpdateResult dtc du
-    liftIO $ void res `shouldBe` expect
-    forM_ res $ \(changes, bs) -> do
-        liftIO $ changes `shouldBe` expectChanges
+    liftIO $ fst <$> res `shouldBe` expect
+    forM_ res $ \(_, bs) -> do
         checkActiveBakers bs
         () <- case flexibleCooldown of
             STrue -> do
@@ -410,14 +459,8 @@ runUpdateDelegatorTest spv dtc@DelegatorTestConfig{..} du@DelegatorUpdate{..} =
                 DummyData.dummyArs
                 (withIsAuthorizationsVersionForPV spv DummyData.dummyKeyCollection)
                 chainParams
-    expectChanges = execWriter $ do
-        forM_ duDelegationTarget $ tell . (: []) . DelegationConfigureDelegationTarget
-        forM_ duRestakeEarnings $ tell . (: []) . DelegationConfigureRestakeEarnings
-        forM_ duCapital $ \newCap ->
-            if newCap >= oldCapital
-                then tell [DelegationConfigureStakeIncreased newCap]
-                else tell [DelegationConfigureStakeReduced newCap]
 
+-- | Test 'bsoUpdateDelegator' with a random configurations.
 testUpdateDelegator ::
     forall pv.
     ( IsProtocolVersion pv,
diff --git a/concordium-consensus/tests/globalstate/GlobalStateTests/ConfigureValidator.hs b/concordium-consensus/tests/globalstate/GlobalStateTests/ConfigureValidator.hs
index 3fa2020e0..36da93483 100644
--- a/concordium-consensus/tests/globalstate/GlobalStateTests/ConfigureValidator.hs
+++ b/concordium-consensus/tests/globalstate/GlobalStateTests/ConfigureValidator.hs
@@ -19,7 +19,6 @@ import Test.QuickCheck
 
 import qualified Concordium.Crypto.BlockSignature as Sig
 import qualified Concordium.Crypto.BlsSignature as Bls
-import qualified Concordium.Crypto.SHA256 as Hash
 import qualified Concordium.Crypto.VRF as VRF
 import Concordium.Types
 import Concordium.Types.Accounts
@@ -27,18 +26,13 @@ import qualified Concordium.Types.DummyData as DummyData
 import Concordium.Types.Execution
 import Concordium.Types.Option
 import Concordium.Types.Parameters
-import Concordium.Types.SeedState
 
 import Concordium.GlobalState.Account
 import Concordium.GlobalState.BakerInfo
 import Concordium.GlobalState.BlockState
 import Concordium.GlobalState.CooldownQueue
 import qualified Concordium.GlobalState.DummyData as DummyData
-import qualified Concordium.GlobalState.Persistent.Accounts as Accounts
-import Concordium.GlobalState.Persistent.Bakers
-import Concordium.GlobalState.Persistent.BlobStore
 import Concordium.GlobalState.Persistent.BlockState
-import qualified Concordium.GlobalState.Persistent.Trie as Trie
 
 import GlobalStateTests.BlockStateHelpers
 

From 9822357da4d7162dde8579187b880f5a28373bcf Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Tue, 13 Aug 2024 16:40:12 +0200
Subject: [PATCH 58/81] Revert version bump

---
 concordium-node/Cargo.lock | 2 +-
 concordium-node/Cargo.toml | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/concordium-node/Cargo.lock b/concordium-node/Cargo.lock
index 5359987c0..8cb19f6e6 100644
--- a/concordium-node/Cargo.lock
+++ b/concordium-node/Cargo.lock
@@ -787,7 +787,7 @@ dependencies = [
 
 [[package]]
 name = "concordium_node"
-version = "7.0.0"
+version = "6.3.1"
 dependencies = [
  "anyhow",
  "app_dirs2",
diff --git a/concordium-node/Cargo.toml b/concordium-node/Cargo.toml
index 4aba0463b..7d67e6233 100644
--- a/concordium-node/Cargo.toml
+++ b/concordium-node/Cargo.toml
@@ -1,6 +1,6 @@
 [package]
 name = "concordium_node"
-version = "7.0.0" # must be kept in sync with 'is_compatible_version' in 'src/configuration.rs'
+version = "6.3.1" # must be kept in sync with 'is_compatible_version' in 'src/configuration.rs'
 description = "Concordium Node"
 authors = ["Concordium <developers@concordium.com>"]
 exclude = [".gitignore", ".gitlab-ci.yml", "test/**/*","**/**/.gitignore","**/**/.gitlab-ci.yml"]

From c55977103d86f8ebab244164732cc6c68ad308b3 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Thu, 15 Aug 2024 15:35:30 +0200
Subject: [PATCH 59/81] Update base. Documentation changes.

---
 concordium-base                                  |  2 +-
 concordium-consensus/src/Concordium/Scheduler.hs | 11 +++++++----
 2 files changed, 8 insertions(+), 5 deletions(-)

diff --git a/concordium-base b/concordium-base
index 38cf687f1..7bd626d97 160000
--- a/concordium-base
+++ b/concordium-base
@@ -1 +1 @@
-Subproject commit 38cf687f16074b9a2538093a40e2befa06cd104d
+Subproject commit 7bd626d9736b4744870dec96559fd87f7d4308ed
diff --git a/concordium-consensus/src/Concordium/Scheduler.hs b/concordium-consensus/src/Concordium/Scheduler.hs
index 11f96d5fe..a0c43f22c 100644
--- a/concordium-consensus/src/Concordium/Scheduler.hs
+++ b/concordium-consensus/src/Concordium/Scheduler.hs
@@ -2022,11 +2022,16 @@ handleAddBaker wtc abElectionVerifyKey abSignatureVerifyKey abAggregationVerifyK
 -- | Argument to configure baker 'withDeposit' continuation.
 data ConfigureBakerCont (av :: AccountVersion)
     = CBCAdd
-        { cbcRemoveDelegator :: Conditionally (SupportsFlexibleCooldown av) Bool,
+        { -- | When flexible cooldown is supported, we can add a baker when there already is a
+          --  delegator on the account, but we have to remove the delegator first. This flag indicates
+          --  if there is a delegator to remove.
+          cbcRemoveDelegator :: Conditionally (SupportsFlexibleCooldown av) Bool,
+          -- | The parameters defining the baker to add.
           cbcValidatorAdd :: BI.ValidatorAdd
         }
     | CBCUpdate
-        { cbcValidatorUpdate :: BI.ValidatorUpdate
+        { -- | The parameters defining the update to the baker.
+          cbcValidatorUpdate :: BI.ValidatorUpdate
         }
 
 -- | Check that the ownership proofs for keys used for a configure baker transaction are valid.
@@ -2039,8 +2044,6 @@ checkConfigureBakerKeys senderAddress BakerKeysWithProofs{..} =
     signP = checkSignatureVerifyKeyProof challenge bkwpSignatureVerifyKey bkwpProofSig
     aggregationP = Bls.checkProofOfKnowledgeSK challenge bkwpProofAggregation bkwpAggregationVerifyKey
 
--- makeConfigureBakerArg
-
 handleConfigureBaker ::
     forall m.
     ( PVSupportsDelegation (MPV m),

From 4f9b85332b16e1b93bb402315bed69b9bdfacee6 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Fri, 23 Aug 2024 18:54:32 +0200
Subject: [PATCH 60/81] Fix behaviour when transitioning from baker to
 delegator or vice-versa where the transaction fails.

---
 .../src/Concordium/GlobalState/BlockState.hs  |   17 +
 .../GlobalState/Persistent/BlockState.hs      |    3 +
 .../src/Concordium/Scheduler.hs               |   32 +-
 .../src/Concordium/Scheduler/Environment.hs   |   17 +-
 .../Scheduler/EnvironmentImplementation.hs    |   67 +-
 .../src/Concordium/Scheduler/Runner.hs        |   20 +
 .../SchedulerTests/ConfigureBaker.hs          | 1233 +++++++++++++++++
 .../scheduler/SchedulerTests/Delegation.hs    |   73 +-
 .../tests/scheduler/SchedulerTests/Helpers.hs |    5 +
 concordium-consensus/tests/scheduler/Spec.hs  |    2 +
 10 files changed, 1426 insertions(+), 43 deletions(-)
 create mode 100644 concordium-consensus/tests/scheduler/SchedulerTests/ConfigureBaker.hs

diff --git a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs
index e4ad75b6b..b3034a13e 100644
--- a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs
@@ -1503,6 +1503,18 @@ class (BlockStateQuery m) => BlockStateOperations m where
     -- | Get whether a protocol update is effective
     bsoIsProtocolUpdateEffective :: UpdatableBlockState m -> m Bool
 
+    -- | A snapshot of the block state that can be used to roll back to a previous state.
+    type StateSnapshot m
+
+    -- | Take a snapshot of the block state that can be used to roll back to the state at the
+    --  snapshot. Note, if the state is restored then any 'UpdatableBlockState' that was derived
+    --  from the original state should be discarded.
+    --  This should be used with caution.
+    bsoSnapshotState :: UpdatableBlockState m -> m (StateSnapshot m)
+
+    -- | Roll back to the state at the snapshot. This should be used with caution.
+    bsoRollback :: UpdatableBlockState m -> StateSnapshot m -> m (UpdatableBlockState m)
+
 -- | Block state storage operations
 class (BlockStateOperations m, FixedSizeSerialization (BlockStateRef m)) => BlockStateStorage m where
     -- | Derive a mutable state instance from a block state instance. The mutable
@@ -1802,6 +1814,9 @@ instance (Monad (t m), MonadTrans t, BlockStateOperations m) => BlockStateOperat
     bsoGetBankStatus = lift . bsoGetBankStatus
     bsoSetRewardAccounts s = lift . bsoSetRewardAccounts s
     bsoIsProtocolUpdateEffective = lift . bsoIsProtocolUpdateEffective
+    type StateSnapshot (MGSTrans t m) = StateSnapshot m
+    bsoSnapshotState = lift . bsoSnapshotState
+    bsoRollback s = lift . bsoRollback s
     {-# INLINE bsoGetModule #-}
     {-# INLINE bsoGetAccount #-}
     {-# INLINE bsoGetAccountIndex #-}
@@ -1855,6 +1870,8 @@ instance (Monad (t m), MonadTrans t, BlockStateOperations m) => BlockStateOperat
     {-# INLINE bsoSetRewardAccounts #-}
     {-# INLINE bsoGetCurrentEpochBakers #-}
     {-# INLINE bsoIsProtocolUpdateEffective #-}
+    {-# INLINE bsoSnapshotState #-}
+    {-# INLINE bsoRollback #-}
 
 instance (Monad (t m), MonadTrans t, BlockStateStorage m) => BlockStateStorage (MGSTrans t m) where
     thawBlockState = lift . thawBlockState
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
index d5de10c84..267dd1023 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
@@ -4308,6 +4308,9 @@ instance (IsProtocolVersion pv, PersistentState av pv r m) => BlockStateOperatio
     bsoGetBankStatus = doGetBankStatus
     bsoSetRewardAccounts = doSetRewardAccounts
     bsoIsProtocolUpdateEffective = doIsProtocolUpdateEffective
+    type StateSnapshot (PersistentBlockStateMonad pv r m) = BlockStatePointers pv
+    bsoSnapshotState = loadPBS
+    bsoRollback = storePBS
 
 instance (IsProtocolVersion pv, PersistentState av pv r m) => BlockStateStorage (PersistentBlockStateMonad pv r m) where
     thawBlockState = doThawBlockState
diff --git a/concordium-consensus/src/Concordium/Scheduler.hs b/concordium-consensus/src/Concordium/Scheduler.hs
index a0c43f22c..1309c961c 100644
--- a/concordium-consensus/src/Concordium/Scheduler.hs
+++ b/concordium-consensus/src/Concordium/Scheduler.hs
@@ -2155,20 +2155,12 @@ handleConfigureBaker
             | not proofsValid =
                 return (TxReject InvalidProof)
             | otherwise = do
-                removedDelegator <- case cbcRemoveDelegator of
+                (removedDelegator, removeStake) <- case cbcRemoveDelegator of
                     CTrue True -> do
-                        -- Remove the delegator if necessary.
-                        -- We know this will succeed because:
-                        -- 1. The account is a delegator.
-                        -- 2. Flexible cooldown is enabled, meaning:
-                        --    * The account cannot have a pending change (which would cause failure)
-                        --    * Setting the capital to 0 will remove the delegator immediately,
-                        --      moving the old staked capital to pre-pre-cooldown.
                         cm <- getChainMetadata
-                        _ <- updateDelegator (slotTime cm) senderAccountIndex BI.delegatorRemove
-                        return True
-                    _ -> return False
-                addValidator senderAccountIndex cbcValidatorAdd <&> \case
+                        return (True, RemoveExistingStake (slotTime cm))
+                    _ -> return (False, NoExistingStake)
+                addValidator senderAccountIndex removeStake cbcValidatorAdd <&> \case
                     Left failure -> rejectResult failure
                     Right () -> addResult removedDelegator cbcValidatorAdd
         executeConfigure (CBCUpdate{..}, accountBalance)
@@ -2311,20 +2303,12 @@ handleConfigureDelegation wtc cdCapital cdRestakeEarnings cdDelegationTarget =
         | accountBalance < BI.daCapital cdcDelegatorAdd =
             return (TxReject InsufficientBalanceForDelegationStake)
         | otherwise = do
-            removedValidator <- case cdcRemoveValidator of
+            (removedValidator, removeStake) <- case cdcRemoveValidator of
                 CTrue True -> do
-                    -- Remove the validator if necessary.
-                    -- We know this will succeed because:
-                    -- 1. The account is a validator.
-                    -- 2. Flexible cooldown is enabled, meaning:
-                    --    * The account cannot have a pending change (which would cause failure)
-                    --    * Setting the capital to 0 will remove the validator immediately,
-                    --      moving the old staked capital to pre-pre-cooldown.
                     cm <- getChainMetadata
-                    _ <- updateValidator (slotTime cm) senderAccountIndex BI.validatorRemove
-                    return True
-                _ -> return False
-            addDelegator senderAccountIndex cdcDelegatorAdd <&> \case
+                    return (True, RemoveExistingStake (slotTime cm))
+                _ -> return (False, NoExistingStake)
+            addDelegator senderAccountIndex removeStake cdcDelegatorAdd <&> \case
                 Left failure -> rejectResult failure
                 Right () -> addResult removedValidator cdcDelegatorAdd
     executeConfigure (CDCUpdate{..}, accountBalance)
diff --git a/concordium-consensus/src/Concordium/Scheduler/Environment.hs b/concordium-consensus/src/Concordium/Scheduler/Environment.hs
index ead45d517..66858e1fb 100644
--- a/concordium-consensus/src/Concordium/Scheduler/Environment.hs
+++ b/concordium-consensus/src/Concordium/Scheduler/Environment.hs
@@ -82,6 +82,15 @@ class (Monad m) => StaticInformation m where
     -- | Get the current exchange rates, that is the Euro per NRG, micro CCD per Euro and the energy rate.
     getExchangeRates :: m ExchangeRates
 
+-- | When adding a validator or delegator to an account, this indicates whether the account has
+--  an existing delegator or validator that must be removed.
+data RemoveExistingStake
+    = -- | The existing stake will be removed. The timestamp is that of the current block.
+      RemoveExistingStake !Timestamp
+    | -- | The account has no existing stake.
+      NoExistingStake
+    deriving (Eq, Show)
+
 -- | Information needed to execute transactions in the form that is easy to use.
 class
     (Monad m, StaticInformation m, AccountOperations m, ContractStateOperations m, ModuleQuery m, MonadLogger m, MonadProtocolVersion m, TVer.TransactionVerifier m) =>
@@ -199,11 +208,13 @@ class
     --  PRECONDITION:
     --   * The account must exist;
     --   * The account must not already be a validator;
-    --   * The account must not be a delegator;
+    --   * The flag must indicate if the account is currently a delegator, which will be removed;
     --   * The account must have sufficient balance to cover the stake.
     addValidator ::
         (PVSupportsDelegation (MPV m)) =>
         AccountIndex ->
+        -- | Whether the account already has a delegator, which will be removed in the process.
+        RemoveExistingStake ->
         ValidatorAdd ->
         m (Either ValidatorConfigureFailure ())
 
@@ -229,11 +240,13 @@ class
     --  PRECONDITION:
     --   * The account must exist;
     --   * The account must not already be a delegator;
-    --   * The account must not be a validator;
+    --   * The flag must indicate if the account is currently a validator, which will be removed;
     --   * The account must have sufficient balance to cover the stake.
     addDelegator ::
         (PVSupportsDelegation (MPV m)) =>
         AccountIndex ->
+        -- | Whether the account already has a validator, which will be removed in the process.
+        RemoveExistingStake ->
         DelegatorAdd ->
         m (Either DelegatorConfigureFailure ())
 
diff --git a/concordium-consensus/src/Concordium/Scheduler/EnvironmentImplementation.hs b/concordium-consensus/src/Concordium/Scheduler/EnvironmentImplementation.hs
index dff293b49..d32b7591d 100644
--- a/concordium-consensus/src/Concordium/Scheduler/EnvironmentImplementation.hs
+++ b/concordium-consensus/src/Concordium/Scheduler/EnvironmentImplementation.hs
@@ -17,6 +17,7 @@ import qualified Data.Kind as DK
 import Lens.Micro.Platform
 
 import Concordium.GlobalState.Account
+import qualified Concordium.GlobalState.BakerInfo as BI
 import qualified Concordium.GlobalState.BlockState as BS
 import Concordium.GlobalState.TreeState
 import Concordium.Logger
@@ -294,13 +295,34 @@ instance
         return ret
 
     {-# INLINE addValidator #-}
-    addValidator ai vadd = do
+    addValidator ai removeDelegator vadd = do
         s <- use ssBlockState
-        lift (BS.bsoAddValidator s ai vadd) >>= \case
-            Left e -> return (Left e)
-            Right s' -> do
-                ssBlockState .= s'
-                return (Right ())
+        (s', res) <- lift (doAdd s)
+        ssBlockState .= s'
+        return res
+      where
+        doAdd s0 | RemoveExistingStake ts <- removeDelegator = do
+            -- We need to remove the delegator first.
+            -- We take a snapshot of the state so we can rollback if the add fails.
+            snapshot <- BS.bsoSnapshotState s0
+            rdRes <- BS.bsoUpdateDelegator s0 ts ai BI.delegatorRemove
+            case rdRes of
+                Left e ->
+                    -- Removing the delegator cannot fail, since the account must have a delegator.
+                    error $ "addValidator: Failed to remove delegator: " ++ show e
+                Right (_, s1) -> do
+                    res <- BS.bsoAddValidator s1 ai vadd
+                    case res of
+                        Left e -> do
+                            -- Rollback the state to the snapshot.
+                            s' <- BS.bsoRollback s1 snapshot
+                            return (s', Left e)
+                        Right s' -> return (s', Right ())
+        doAdd s = do
+            res <- BS.bsoAddValidator s ai vadd
+            return $! case res of
+                Left e -> (s, Left e)
+                Right s' -> (s', Right ())
 
     {-# INLINE updateValidator #-}
     updateValidator ts ai vadd = do
@@ -312,13 +334,34 @@ instance
                 return (Right events)
 
     {-# INLINE addDelegator #-}
-    addDelegator ai dadd = do
+    addDelegator ai removeValidator dadd = do
         s <- use ssBlockState
-        lift (BS.bsoAddDelegator s ai dadd) >>= \case
-            Left e -> return (Left e)
-            Right s' -> do
-                ssBlockState .= s'
-                return (Right ())
+        (s', res) <- lift (doAdd s)
+        ssBlockState .= s'
+        return res
+      where
+        doAdd s0 | RemoveExistingStake ts <- removeValidator = do
+            -- We need to remove the validator first.
+            -- We take a snapshot of the state so we can rollback if the add fails.
+            snapshot <- BS.bsoSnapshotState s0
+            rvRes <- BS.bsoUpdateValidator s0 ts ai BI.validatorRemove
+            case rvRes of
+                Left e ->
+                    -- Removing the validator cannot fail, since the account must have a validator.
+                    error $ "addDelegator: Failed to remove validator: " ++ show e
+                Right (_, s1) -> do
+                    res <- BS.bsoAddDelegator s1 ai dadd
+                    case res of
+                        Left e -> do
+                            -- Rollback the state to the snapshot.
+                            s' <- BS.bsoRollback s1 snapshot
+                            return (s', Left e)
+                        Right s' -> return (s', Right ())
+        doAdd s = do
+            res <- BS.bsoAddDelegator s ai dadd
+            return $! case res of
+                Left e -> (s, Left e)
+                Right s' -> (s', Right ())
 
     {-# INLINE updateDelegator #-}
     updateDelegator ts ai dadd = do
diff --git a/concordium-consensus/src/Concordium/Scheduler/Runner.hs b/concordium-consensus/src/Concordium/Scheduler/Runner.hs
index f7d341429..3905cc0a4 100644
--- a/concordium-consensus/src/Concordium/Scheduler/Runner.hs
+++ b/concordium-consensus/src/Concordium/Scheduler/Runner.hs
@@ -120,6 +120,8 @@ transactionHelper t =
             return $ signTx keys meta (Types.encodePayload Types.EncryptedAmountTransferWithMemo{..})
         (TJSON meta TransferWithScheduleAndMemo{..} keys) ->
             return $ signTx keys meta (Types.encodePayload Types.TransferWithScheduleAndMemo{..})
+        (TJSON meta ConfigureBaker{..} keys) ->
+            return $ signTx keys meta (Types.encodePayload Types.ConfigureBaker{..})
         (TJSON meta ConfigureDelegation{..} keys) ->
             return $ signTx keys meta (Types.encodePayload Types.ConfigureDelegation{..})
 
@@ -232,6 +234,24 @@ data PayloadJSON
           twswmMemo :: !Memo,
           twswmSchedule :: ![(Timestamp, Amount)]
         }
+    | ConfigureBaker
+        { -- | The equity capital of the baker
+          cbCapital :: !(Maybe Amount),
+          -- | Whether the baker's earnings are restaked
+          cbRestakeEarnings :: !(Maybe Bool),
+          -- | Whether the pool is open for delegators
+          cbOpenForDelegation :: !(Maybe Types.OpenStatus),
+          -- | The key/proof pairs to verify baker.
+          cbKeysWithProofs :: !(Maybe Types.BakerKeysWithProofs),
+          -- | The URL referencing the baker's metadata.
+          cbMetadataURL :: !(Maybe UrlText),
+          -- | The commission the pool owner takes on transaction fees.
+          cbTransactionFeeCommission :: !(Maybe AmountFraction),
+          -- | The commission the pool owner takes on baking rewards.
+          cbBakingRewardCommission :: !(Maybe AmountFraction),
+          -- | The commission the pool owner takes on finalization rewards.
+          cbFinalizationRewardCommission :: !(Maybe AmountFraction)
+        }
     | ConfigureDelegation
         { -- | The capital delegated to the pool.
           cdCapital :: !(Maybe Amount),
diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/ConfigureBaker.hs b/concordium-consensus/tests/scheduler/SchedulerTests/ConfigureBaker.hs
new file mode 100644
index 000000000..7d4dc452b
--- /dev/null
+++ b/concordium-consensus/tests/scheduler/SchedulerTests/ConfigureBaker.hs
@@ -0,0 +1,1233 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+
+-- | Tests for the 'ConfigureBaker' transaction.
+module SchedulerTests.ConfigureBaker (tests) where
+
+import Data.Bool.Singletons
+import Lens.Micro.Platform
+
+import qualified Concordium.Cost as Cost
+import qualified Concordium.Crypto.BlockSignature as Sig
+import qualified Concordium.Crypto.BlsSignature as Bls
+import qualified Concordium.Crypto.Proofs as Proofs
+import qualified Concordium.Crypto.SignatureScheme as SigScheme
+import qualified Concordium.Crypto.VRF as VRF
+import Concordium.ID.Types as ID
+import Concordium.Types.Accounts
+
+import Concordium.GlobalState.BakerInfo
+import qualified Concordium.GlobalState.Basic.BlockState.Account as Transient
+import qualified Concordium.GlobalState.BlockState as BS
+import qualified Concordium.GlobalState.Persistent.Account as BS
+import qualified Concordium.GlobalState.Persistent.BlobStore as Blob
+import qualified Concordium.GlobalState.Persistent.BlockState as BS
+import qualified Concordium.Scheduler.Runner as Runner
+import Concordium.Scheduler.Types
+import qualified Concordium.Scheduler.Types as Types
+
+import Concordium.GlobalState.CooldownQueue
+import Concordium.GlobalState.DummyData
+import Concordium.Scheduler.DummyData
+import qualified Concordium.Types.DummyData as DummyData
+import Concordium.Types.Option
+import Data.Maybe
+import qualified SchedulerTests.Helpers as Helpers
+import Test.HUnit
+import Test.Hspec
+
+-- | Deterministically generate a baker account from a seed.
+makeTestBakerV1FromSeed ::
+    (IsAccountVersion av, Blob.MonadBlobStore m, AVSupportsDelegation av) =>
+    -- | The initial balance of the account.
+    Amount ->
+    -- | The initial staked amount of the account.
+    -- Must be less than or equal to the initial balance.
+    Amount ->
+    -- | The baker id of the account.
+    -- Must match the account index, which is the index of the account in the initial block state.
+    BakerId ->
+    -- | Seed used to generate account and baker keys.
+    Int ->
+    m (BS.PersistentAccount av)
+makeTestBakerV1FromSeed amount stake bakerId seed = do
+    account <- Helpers.makeTestAccountFromSeed amount seed
+    let (fulBaker, _, _, _) = mkFullBaker seed bakerId
+    let bakerInfoEx =
+            BakerInfoExV1
+                { _bieBakerInfo = fulBaker ^. theBakerInfo,
+                  _bieBakerPoolInfo = poolInfo
+                }
+    BS.addAccountBakerV1 bakerInfoEx stake True account
+  where
+    poolInfo =
+        BakerPoolInfo
+            { _poolOpenStatus = OpenForAll,
+              _poolMetadataUrl = UrlText "Some URL",
+              _poolCommissionRates =
+                CommissionRates
+                    { _finalizationCommission = makeAmountFraction 50_000,
+                      _bakingCommission = makeAmountFraction 50_000,
+                      _transactionCommission = makeAmountFraction 50_000
+                    }
+            }
+
+-- | Deterministically generate a delegator account from a seed.
+makeTestDelegatorFromSeed ::
+    (IsAccountVersion av, Blob.MonadBlobStore m, AVSupportsDelegation av) =>
+    -- | The initial balance of the account.
+    Amount ->
+    -- | The delegating details added to the account.
+    AccountDelegation av ->
+    -- | Seed used to generate the account.
+    Int ->
+    m (BS.PersistentAccount av)
+makeTestDelegatorFromSeed amount accountDelegation seed = do
+    account <- Helpers.makeTestAccountFromSeed amount seed
+    BS.addAccountDelegator accountDelegation account
+
+-- Accounts
+
+-- | Account of the baker 0.
+baker0Account ::
+    (IsAccountVersion av, Blob.MonadBlobStore m, AVSupportsDelegation av) =>
+    m (BS.PersistentAccount av)
+baker0Account = makeTestBakerV1FromSeed 1_000_000_000_000 1_000_000_000_000 bakerId seed
+  where
+    bakerId = 0
+    seed = 16
+
+-- | Account of the delegator1.
+delegator1Account ::
+    (IsAccountVersion av, Blob.MonadBlobStore m, AVSupportsDelegation av) =>
+    m (BS.PersistentAccount av)
+delegator1Account = makeTestDelegatorFromSeed 20_000_000_000_000 accountDelegation 17
+  where
+    accountDelegation =
+        AccountDelegationV1
+            { _delegationIdentity = 1,
+              _delegationStakedAmount = 19_000_000_000_000, -- leverage cap is set to 5 in createBlockState, so this puts it over the cap.
+              _delegationStakeEarnings = False,
+              _delegationTarget = DelegateToBaker 0,
+              _delegationPendingChange = NoChange
+            }
+
+-- | Account address of the delegator1.
+delegator1Address :: AccountAddress
+delegator1Address = Helpers.accountAddressFromSeed 17
+
+-- | Account keys of the delegator1 account.
+delegator1KP :: SigScheme.KeyPair
+delegator1KP = Helpers.keyPairFromSeed 17
+
+-- | Account of the baker 2.
+baker2Account ::
+    (IsAccountVersion av, Blob.MonadBlobStore m, AVSupportsDelegation av) =>
+    m (BS.PersistentAccount av)
+baker2Account = makeTestBakerV1FromSeed balance stake bakerId seed
+  where
+    balance = 1_000_000_000_000
+    stake = 1_000_000_000
+    bakerId = 2
+    seed = 18
+
+-- | An account with no staking.
+dummy3Account ::
+    (IsAccountVersion av, Blob.MonadBlobStore m, AVSupportsDelegation av) =>
+    m (BS.PersistentAccount av)
+dummy3Account = Helpers.makeTestAccountFromSeed 20_000_000_000_000 19
+
+-- | Address of the dummy3 account.
+dummy3Address :: AccountAddress
+dummy3Address = Helpers.accountAddressFromSeed 19
+
+-- | Keys of the dummy3 account.
+dummy3KP :: SigScheme.KeyPair
+dummy3KP = Helpers.keyPairFromSeed 19
+
+-- | Account of the baker 4.
+baker4Account ::
+    (IsAccountVersion av, Blob.MonadBlobStore m, AVSupportsDelegation av) =>
+    m (BS.PersistentAccount av)
+baker4Account = makeTestBakerV1FromSeed 20_000_000_000_000 500_000_000_000 bakerId seed
+  where
+    bakerId = 4
+    seed = 20
+
+-- | Account address of the delegator3.
+baker4Address :: AccountAddress
+baker4Address = Helpers.accountAddressFromSeed 20
+
+-- | Account keys of the delegator3 account.
+baker4KP :: SigScheme.KeyPair
+baker4KP = Helpers.keyPairFromSeed 20
+
+-- | Create initial block state with account
+--  account index 0 is baker0
+--  account index 1 is delegator 1 (delegates to baker 0 with overdelegation)
+--  account index 2 is baker 2
+--  account index 4 is baker 4
+initialBlockState2 ::
+    (IsProtocolVersion pv, PVSupportsDelegation pv) =>
+    Helpers.PersistentBSM pv (BS.HashedPersistentBlockState pv)
+initialBlockState2 =
+    Helpers.createTestBlockStateWithAccountsM
+        [ baker0Account,
+          delegator1Account,
+          baker2Account,
+          dummy3Account,
+          baker4Account
+        ]
+
+-- | Construct a (valid) 'BakerKeysWithProofs' from the given account address for keys generated
+--  with the given seed.
+makeBakerKeysWithProofs :: AccountAddress -> Int -> IO BakerKeysWithProofs
+makeBakerKeysWithProofs senderAddress seed = do
+    bkwpProofElection <- fromJust <$> Proofs.proveDlog25519VRF challenge kpElection
+    bkwpProofSig <- fromJust <$> Proofs.proveDlog25519Block challenge kpSignature
+    bkwpProofAggregation <- Bls.proveKnowledgeOfSK challenge skAggregate
+    return BakerKeysWithProofs{..}
+  where
+    (fulBaker, skElection, skSignature, skAggregate) = mkFullBaker seed 0
+    bkwpElectionVerifyKey = fulBaker ^. theBakerInfo . bakerElectionVerifyKey
+    bkwpSignatureVerifyKey = fulBaker ^. theBakerInfo . bakerSignatureVerifyKey
+    bkwpAggregationVerifyKey = fulBaker ^. theBakerInfo . bakerAggregationVerifyKey
+    kpElection = VRF.KeyPair skElection bkwpElectionVerifyKey
+    kpSignature = Sig.KeyPair skSignature bkwpSignatureVerifyKey
+    challenge = Types.configureBakerKeyChallenge senderAddress bkwpElectionVerifyKey bkwpSignatureVerifyKey bkwpAggregationVerifyKey
+
+-- | Transition delegator 1 to baker 1.
+testDelegatorToBakerOk ::
+    forall pv.
+    (IsProtocolVersion pv, PVSupportsDelegation pv) =>
+    SProtocolVersion pv ->
+    String ->
+    Spec
+testDelegatorToBakerOk spv pvString =
+    specify (pvString ++ ": Delegator -> Baker (OK)") $ do
+        keysWithProofs <- makeBakerKeysWithProofs delegator1Address 1
+        let transactions =
+                [ Runner.TJSON
+                    { payload =
+                        Runner.ConfigureBaker
+                            { cbCapital = Just stakeAmount,
+                              cbRestakeEarnings = Nothing,
+                              cbOpenForDelegation = Just OpenForAll,
+                              cbKeysWithProofs = Just keysWithProofs,
+                              cbMetadataURL = Just emptyUrlText,
+                              cbTransactionFeeCommission = Just (makeAmountFraction 1_000),
+                              cbBakingRewardCommission = Just (makeAmountFraction 1_000),
+                              cbFinalizationRewardCommission = Just (makeAmountFraction 1_000)
+                            },
+                      metadata = makeDummyHeader delegator1Address 1 10_000,
+                      keys = [(0, [(0, delegator1KP)])]
+                    }
+                ]
+        (result, doBlockStateAssertions) <-
+            Helpers.runSchedulerTestTransactionJson
+                Helpers.defaultTestConfig
+                (initialBlockState2 @pv)
+                (Helpers.checkReloadCheck (checkState keysWithProofs))
+                transactions
+        () <- case sSupportsFlexibleCooldown (sAccountVersionFor spv) of
+            SFalse -> Helpers.assertRejectWithReason AlreadyADelegator result
+            STrue -> Helpers.assertSuccessWithEvents (events keysWithProofs) result
+        doBlockStateAssertions
+  where
+    stakeAmount = 300_000_000_000
+    events keysWithProofs =
+        [ DelegationRemoved{edrDelegatorId = 1, edrAccount = delegator1Address},
+          BakerAdded
+            { ebaBakerId = 1,
+              ebaAccount = delegator1Address,
+              ebaSignKey = bkwpSignatureVerifyKey keysWithProofs,
+              ebaElectionKey = bkwpElectionVerifyKey keysWithProofs,
+              ebaAggregationKey = bkwpAggregationVerifyKey keysWithProofs,
+              ebaStake = stakeAmount,
+              ebaRestakeEarnings = False -- Inherited from the delegator
+            },
+          BakerSetRestakeEarnings
+            { ebsreBakerId = 1,
+              ebsreAccount = delegator1Address,
+              ebsreRestakeEarnings = False
+            },
+          BakerSetOpenStatus
+            { ebsosBakerId = 1,
+              ebsosAccount = delegator1Address,
+              ebsosOpenStatus = OpenForAll
+            },
+          BakerSetMetadataURL
+            { ebsmuBakerId = 1,
+              ebsmuAccount = delegator1Address,
+              ebsmuMetadataURL = emptyUrlText
+            },
+          BakerSetTransactionFeeCommission
+            { ebstfcBakerId = 1,
+              ebstfcAccount = delegator1Address,
+              ebstfcTransactionFeeCommission = makeAmountFraction 1_000
+            },
+          BakerSetBakingRewardCommission
+            { ebsbrcBakerId = 1,
+              ebsbrcAccount = delegator1Address,
+              ebsbrcBakingRewardCommission = makeAmountFraction 1_000
+            },
+          BakerSetFinalizationRewardCommission
+            { ebsfrcBakerId = 1,
+              ebsfrcAccount = delegator1Address,
+              ebsfrcFinalizationRewardCommission = makeAmountFraction 1_000
+            }
+        ]
+    -- Transaction length is 438 bytes (378 bytes for the transaction and 60 bytes for the header).
+    transactionEnergy = Cost.configureBakerCostWithKeys + Cost.baseCost 438 1
+    checkState ::
+        BakerKeysWithProofs ->
+        Helpers.SchedulerResult ->
+        BS.PersistentBlockState pv ->
+        Helpers.PersistentBSM pv Assertion
+    checkState keysWithProofs result blockState = do
+        invariants <- Helpers.assertBlockStateInvariantsH blockState (Helpers.srExecutionCosts result)
+        updatedAccount1 <- BS.toTransientAccount . fromJust =<< BS.bsoGetAccountByIndex blockState 1
+        initialAccount1 <- BS.toTransientAccount =<< delegator1Account @(AccountVersionFor pv)
+        return $ do
+            invariants
+            assertEqual
+                "Expected account update"
+                ( initialAccount1
+                    & Transient.accountNonce .~ 2
+                    & Transient.accountAmount -~ Helpers.energyToAmount transactionEnergy
+                    & updateStaking keysWithProofs
+                )
+                updatedAccount1
+    updatedBakerInfo :: BakerKeysWithProofs -> BakerInfoEx (AccountVersionFor pv)
+    updatedBakerInfo keysWithProofs =
+        BakerInfoExV1
+            { _bieBakerInfo =
+                BakerInfo
+                    { _bakerSignatureVerifyKey = bkwpSignatureVerifyKey keysWithProofs,
+                      _bakerElectionVerifyKey = bkwpElectionVerifyKey keysWithProofs,
+                      _bakerAggregationVerifyKey = bkwpAggregationVerifyKey keysWithProofs,
+                      _bakerIdentity = 1
+                    },
+              _bieBakerPoolInfo =
+                BakerPoolInfo
+                    { _poolOpenStatus = OpenForAll,
+                      _poolMetadataUrl = emptyUrlText,
+                      _poolCommissionRates =
+                        CommissionRates
+                            { _finalizationCommission = makeAmountFraction 1_000,
+                              _bakingCommission = makeAmountFraction 1_000,
+                              _transactionCommission = makeAmountFraction 1_000
+                            }
+                    }
+            }
+    updateStaking keysWithProofs = case sSupportsFlexibleCooldown (sAccountVersionFor spv) of
+        SFalse -> id
+        STrue ->
+            ( Transient.accountStaking
+                .~ AccountStakeBaker
+                    ( AccountBaker
+                        { _stakedAmount = stakeAmount,
+                          _stakeEarnings = False,
+                          _accountBakerInfo = updatedBakerInfo keysWithProofs,
+                          _bakerPendingChange = NoChange
+                        }
+                    )
+            )
+                . ( Transient.accountStakeCooldown
+                        .~ CTrue (emptyCooldowns{prePreCooldown = Present 18_700_000_000_000})
+                  )
+
+-- | Transition delegator 1 to baker 1 using a duplicate aggregation key.
+testDelegatorToBakerDuplicateKey ::
+    forall pv.
+    (IsProtocolVersion pv, PVSupportsDelegation pv) =>
+    SProtocolVersion pv ->
+    String ->
+    Spec
+testDelegatorToBakerDuplicateKey spv pvString =
+    specify (pvString ++ ": Delegator -> Baker (Duplicate Aggregation Key)") $ do
+        -- Reuse the same keys that baker 0 uses.
+        keysWithProofs <- makeBakerKeysWithProofs delegator1Address 16
+        let transactions =
+                [ Runner.TJSON
+                    { payload =
+                        Runner.ConfigureBaker
+                            { cbCapital = Just stakeAmount,
+                              cbRestakeEarnings = Nothing,
+                              cbOpenForDelegation = Just OpenForAll,
+                              cbKeysWithProofs = Just keysWithProofs,
+                              cbMetadataURL = Just emptyUrlText,
+                              cbTransactionFeeCommission = Just (makeAmountFraction 1_000),
+                              cbBakingRewardCommission = Just (makeAmountFraction 1_000),
+                              cbFinalizationRewardCommission = Just (makeAmountFraction 1_000)
+                            },
+                      metadata = makeDummyHeader delegator1Address 1 10_000,
+                      keys = [(0, [(0, delegator1KP)])]
+                    }
+                ]
+        (result, doBlockStateAssertions) <-
+            Helpers.runSchedulerTestTransactionJson
+                Helpers.defaultTestConfig
+                (initialBlockState2 @pv)
+                (Helpers.checkReloadCheck checkState)
+                transactions
+        () <- case sSupportsFlexibleCooldown (sAccountVersionFor spv) of
+            SFalse -> Helpers.assertRejectWithReason AlreadyADelegator result
+            STrue ->
+                Helpers.assertRejectWithReason
+                    (DuplicateAggregationKey (bkwpAggregationVerifyKey keysWithProofs))
+                    result
+        doBlockStateAssertions
+  where
+    stakeAmount = 300_000_000_000
+    -- Transaction length is 438 bytes (378 bytes for the transaction and 60 bytes for the header).
+    transactionEnergy = Cost.configureBakerCostWithKeys + Cost.baseCost 438 1
+    checkState ::
+        Helpers.SchedulerResult ->
+        BS.PersistentBlockState pv ->
+        Helpers.PersistentBSM pv Assertion
+    checkState result blockState = do
+        invariants <- Helpers.assertBlockStateInvariantsH blockState (Helpers.srExecutionCosts result)
+        updatedAccount1 <- BS.toTransientAccount . fromJust =<< BS.bsoGetAccountByIndex blockState 1
+        initialAccount1 <- BS.toTransientAccount =<< delegator1Account @(AccountVersionFor pv)
+        return $ do
+            invariants
+            assertEqual
+                "Expected account update"
+                ( initialAccount1
+                    & Transient.accountNonce .~ 2
+                    & Transient.accountAmount -~ Helpers.energyToAmount transactionEnergy
+                )
+                updatedAccount1
+
+-- | Transition delegator 1 to baker 1 using a duplicate aggregation key.
+testDelegatorToBakerMissingParam ::
+    forall pv.
+    (IsProtocolVersion pv, PVSupportsDelegation pv) =>
+    SProtocolVersion pv ->
+    String ->
+    Spec
+testDelegatorToBakerMissingParam spv pvString =
+    specify (pvString ++ ": Delegator -> Baker (Missing Parameter)") $ do
+        -- Reuse the same keys that baker 0 uses.
+        keysWithProofs <- makeBakerKeysWithProofs delegator1Address 16
+        let transactions =
+                [ Runner.TJSON
+                    { payload =
+                        Runner.ConfigureBaker
+                            { cbCapital = Just stakeAmount,
+                              cbRestakeEarnings = Nothing,
+                              cbOpenForDelegation = Nothing,
+                              cbKeysWithProofs = Just keysWithProofs,
+                              cbMetadataURL = Just emptyUrlText,
+                              cbTransactionFeeCommission = Just (makeAmountFraction 1_000),
+                              cbBakingRewardCommission = Just (makeAmountFraction 1_000),
+                              cbFinalizationRewardCommission = Just (makeAmountFraction 1_000)
+                            },
+                      metadata = makeDummyHeader delegator1Address 1 10_000,
+                      keys = [(0, [(0, delegator1KP)])]
+                    }
+                ]
+        (result, doBlockStateAssertions) <-
+            Helpers.runSchedulerTestTransactionJson
+                Helpers.defaultTestConfig
+                (initialBlockState2 @pv)
+                (Helpers.checkReloadCheck checkState)
+                transactions
+        () <- case sSupportsFlexibleCooldown (sAccountVersionFor spv) of
+            SFalse -> Helpers.assertRejectWithReason AlreadyADelegator result
+            STrue -> Helpers.assertRejectWithReason MissingBakerAddParameters result
+        doBlockStateAssertions
+  where
+    stakeAmount = 300_000_000_000
+    -- Transaction length is 437 bytes (378 bytes for the transaction and 60 bytes for the header).
+    transactionEnergy = Cost.configureBakerCostWithKeys + Cost.baseCost 437 1
+    checkState ::
+        Helpers.SchedulerResult ->
+        BS.PersistentBlockState pv ->
+        Helpers.PersistentBSM pv Assertion
+    checkState result blockState = do
+        invariants <- Helpers.assertBlockStateInvariantsH blockState (Helpers.srExecutionCosts result)
+        updatedAccount1 <- BS.toTransientAccount . fromJust =<< BS.bsoGetAccountByIndex blockState 1
+        initialAccount1 <- BS.toTransientAccount =<< delegator1Account @(AccountVersionFor pv)
+        return $ do
+            invariants
+            assertEqual
+                "Expected account update"
+                ( initialAccount1
+                    & Transient.accountNonce .~ 2
+                    & Transient.accountAmount -~ Helpers.energyToAmount transactionEnergy
+                )
+                updatedAccount1
+
+-- | Test adding a baker successfully.
+testAddBakerOk ::
+    forall pv.
+    (IsProtocolVersion pv, PVSupportsDelegation pv) =>
+    SProtocolVersion pv ->
+    String ->
+    Spec
+testAddBakerOk _spv pvString =
+    specify (pvString ++ ": AddBaker (OK)") $ do
+        keysWithProofs <- makeBakerKeysWithProofs dummy3Address 3
+        let transactions =
+                [ Runner.TJSON
+                    { payload =
+                        Runner.ConfigureBaker
+                            { cbCapital = Just stakeAmount,
+                              cbRestakeEarnings = Just True,
+                              cbOpenForDelegation = Just OpenForAll,
+                              cbKeysWithProofs = Just keysWithProofs,
+                              cbMetadataURL = Just emptyUrlText,
+                              cbTransactionFeeCommission = Just (makeAmountFraction 1_000),
+                              cbBakingRewardCommission = Just (makeAmountFraction 1_000),
+                              cbFinalizationRewardCommission = Just (makeAmountFraction 1_000)
+                            },
+                      metadata = makeDummyHeader dummy3Address 1 transactionEnergy,
+                      keys = [(0, [(0, dummy3KP)])]
+                    }
+                ]
+        (result, doBlockStateAssertions) <-
+            Helpers.runSchedulerTestTransactionJson
+                Helpers.defaultTestConfig
+                (initialBlockState2 @pv)
+                (Helpers.checkReloadCheck (checkState keysWithProofs))
+                transactions
+        Helpers.assertSuccessWithEvents (events keysWithProofs) result
+        doBlockStateAssertions
+  where
+    -- This stake is the maximal amount at which this will succeed.
+    stakeAmount = 20_000_000_000_000 - Helpers.energyToAmount transactionEnergy
+    events keysWithProofs =
+        [ BakerAdded
+            { ebaBakerId = 3,
+              ebaAccount = dummy3Address,
+              ebaSignKey = bkwpSignatureVerifyKey keysWithProofs,
+              ebaElectionKey = bkwpElectionVerifyKey keysWithProofs,
+              ebaAggregationKey = bkwpAggregationVerifyKey keysWithProofs,
+              ebaStake = stakeAmount,
+              ebaRestakeEarnings = True
+            },
+          BakerSetRestakeEarnings
+            { ebsreBakerId = 3,
+              ebsreAccount = dummy3Address,
+              ebsreRestakeEarnings = True
+            },
+          BakerSetOpenStatus
+            { ebsosBakerId = 3,
+              ebsosAccount = dummy3Address,
+              ebsosOpenStatus = OpenForAll
+            },
+          BakerSetMetadataURL
+            { ebsmuBakerId = 3,
+              ebsmuAccount = dummy3Address,
+              ebsmuMetadataURL = emptyUrlText
+            },
+          BakerSetTransactionFeeCommission
+            { ebstfcBakerId = 3,
+              ebstfcAccount = dummy3Address,
+              ebstfcTransactionFeeCommission = makeAmountFraction 1_000
+            },
+          BakerSetBakingRewardCommission
+            { ebsbrcBakerId = 3,
+              ebsbrcAccount = dummy3Address,
+              ebsbrcBakingRewardCommission = makeAmountFraction 1_000
+            },
+          BakerSetFinalizationRewardCommission
+            { ebsfrcBakerId = 3,
+              ebsfrcAccount = dummy3Address,
+              ebsfrcFinalizationRewardCommission = makeAmountFraction 1_000
+            }
+        ]
+    -- Transaction length is 438 bytes (379 bytes for the transaction and 60 bytes for the header).
+    transactionEnergy = Cost.configureBakerCostWithKeys + Cost.baseCost 439 1
+    checkState ::
+        BakerKeysWithProofs ->
+        Helpers.SchedulerResult ->
+        BS.PersistentBlockState pv ->
+        Helpers.PersistentBSM pv Assertion
+    checkState keysWithProofs result blockState = do
+        invariants <- Helpers.assertBlockStateInvariantsH blockState (Helpers.srExecutionCosts result)
+        updatedAccount1 <- BS.toTransientAccount . fromJust =<< BS.bsoGetAccountByIndex blockState 3
+        initialAccount1 <- BS.toTransientAccount =<< dummy3Account @(AccountVersionFor pv)
+        return $ do
+            invariants
+            assertEqual
+                "Expected account update"
+                ( initialAccount1
+                    & Transient.accountNonce .~ 2
+                    & Transient.accountAmount -~ Helpers.energyToAmount transactionEnergy
+                    & updateStaking keysWithProofs
+                )
+                updatedAccount1
+    updatedBakerInfo :: BakerKeysWithProofs -> BakerInfoEx (AccountVersionFor pv)
+    updatedBakerInfo keysWithProofs =
+        BakerInfoExV1
+            { _bieBakerInfo =
+                BakerInfo
+                    { _bakerSignatureVerifyKey = bkwpSignatureVerifyKey keysWithProofs,
+                      _bakerElectionVerifyKey = bkwpElectionVerifyKey keysWithProofs,
+                      _bakerAggregationVerifyKey = bkwpAggregationVerifyKey keysWithProofs,
+                      _bakerIdentity = 3
+                    },
+              _bieBakerPoolInfo =
+                BakerPoolInfo
+                    { _poolOpenStatus = OpenForAll,
+                      _poolMetadataUrl = emptyUrlText,
+                      _poolCommissionRates =
+                        CommissionRates
+                            { _finalizationCommission = makeAmountFraction 1_000,
+                              _bakingCommission = makeAmountFraction 1_000,
+                              _transactionCommission = makeAmountFraction 1_000
+                            }
+                    }
+            }
+    updateStaking keysWithProofs =
+        ( Transient.accountStaking
+            .~ AccountStakeBaker
+                ( AccountBaker
+                    { _stakedAmount = stakeAmount,
+                      _stakeEarnings = True,
+                      _accountBakerInfo = updatedBakerInfo keysWithProofs,
+                      _bakerPendingChange = NoChange
+                    }
+                )
+        )
+
+-- | Test that adding a baker with insufficient balance is rejected.
+testAddBakerInsufficientBalance ::
+    forall pv.
+    (IsProtocolVersion pv, PVSupportsDelegation pv) =>
+    SProtocolVersion pv ->
+    String ->
+    Spec
+testAddBakerInsufficientBalance _spv pvString =
+    specify (pvString ++ ": AddBaker (InsufficientBalance)") $ do
+        keysWithProofs <- makeBakerKeysWithProofs dummy3Address 3
+        let transactions =
+                [ Runner.TJSON
+                    { payload =
+                        Runner.ConfigureBaker
+                            { cbCapital = Just stakeAmount,
+                              cbRestakeEarnings = Just True,
+                              cbOpenForDelegation = Just OpenForAll,
+                              cbKeysWithProofs = Just keysWithProofs,
+                              cbMetadataURL = Just emptyUrlText,
+                              cbTransactionFeeCommission = Just (makeAmountFraction 1_000),
+                              cbBakingRewardCommission = Just (makeAmountFraction 1_000),
+                              cbFinalizationRewardCommission = Just (makeAmountFraction 1_000)
+                            },
+                      metadata = makeDummyHeader dummy3Address 1 transactionEnergy,
+                      keys = [(0, [(0, dummy3KP)])]
+                    }
+                ]
+        (result, doBlockStateAssertions) <-
+            Helpers.runSchedulerTestTransactionJson
+                Helpers.defaultTestConfig
+                (initialBlockState2 @pv)
+                (Helpers.checkReloadCheck checkState)
+                transactions
+        Helpers.assertRejectWithReason InsufficientBalanceForBakerStake result
+        doBlockStateAssertions
+  where
+    -- This stake is the minimal amount at which this will fail.
+    stakeAmount = 20_000_000_000_000 - Helpers.energyToAmount transactionEnergy + 1
+    -- Transaction length is 438 bytes (379 bytes for the transaction and 60 bytes for the header).
+    transactionEnergy = Cost.configureBakerCostWithKeys + Cost.baseCost 439 1
+    checkState ::
+        Helpers.SchedulerResult ->
+        BS.PersistentBlockState pv ->
+        Helpers.PersistentBSM pv Assertion
+    checkState result blockState = do
+        invariants <- Helpers.assertBlockStateInvariantsH blockState (Helpers.srExecutionCosts result)
+        updatedAccount1 <- BS.toTransientAccount . fromJust =<< BS.bsoGetAccountByIndex blockState 3
+        initialAccount1 <- BS.toTransientAccount =<< dummy3Account @(AccountVersionFor pv)
+        return $ do
+            invariants
+            assertEqual
+                "Expected account update"
+                ( initialAccount1
+                    & Transient.accountNonce .~ 2
+                    & Transient.accountAmount -~ Helpers.energyToAmount transactionEnergy
+                )
+                updatedAccount1
+
+-- | Test that adding a baker with incomplete parameters is rejected.
+testAddBakerMissingParam ::
+    forall pv.
+    (IsProtocolVersion pv, PVSupportsDelegation pv) =>
+    SProtocolVersion pv ->
+    String ->
+    Spec
+testAddBakerMissingParam _spv pvString =
+    specify (pvString ++ ": AddBaker (Missing Parameter)") $ do
+        keysWithProofs <- makeBakerKeysWithProofs dummy3Address 3
+        let transactions =
+                [ Runner.TJSON
+                    { payload =
+                        Runner.ConfigureBaker
+                            { cbCapital = Just stakeAmount,
+                              cbRestakeEarnings = Just True,
+                              cbOpenForDelegation = Just OpenForAll,
+                              cbKeysWithProofs = Just keysWithProofs,
+                              cbMetadataURL = Nothing,
+                              cbTransactionFeeCommission = Just (makeAmountFraction 1_000),
+                              cbBakingRewardCommission = Just (makeAmountFraction 1_000),
+                              cbFinalizationRewardCommission = Just (makeAmountFraction 1_000)
+                            },
+                      metadata = makeDummyHeader dummy3Address 1 transactionEnergy,
+                      keys = [(0, [(0, dummy3KP)])]
+                    }
+                ]
+        (result, doBlockStateAssertions) <-
+            Helpers.runSchedulerTestTransactionJson
+                Helpers.defaultTestConfig
+                (initialBlockState2 @pv)
+                (Helpers.checkReloadCheck checkState)
+                transactions
+        Helpers.assertRejectWithReason MissingBakerAddParameters result
+        doBlockStateAssertions
+  where
+    -- This stake is the minimal amount at which this will fail.
+    stakeAmount = 20_000_000_000_000 - Helpers.energyToAmount transactionEnergy + 1
+    -- Transaction length is 437 bytes (377 bytes for the transaction and 60 bytes for the header).
+    transactionEnergy = Cost.configureBakerCostWithKeys + Cost.baseCost 437 1
+    checkState ::
+        Helpers.SchedulerResult ->
+        BS.PersistentBlockState pv ->
+        Helpers.PersistentBSM pv Assertion
+    checkState result blockState = do
+        invariants <- Helpers.assertBlockStateInvariantsH blockState (Helpers.srExecutionCosts result)
+        updatedAccount1 <- BS.toTransientAccount . fromJust =<< BS.bsoGetAccountByIndex blockState 3
+        initialAccount1 <- BS.toTransientAccount =<< dummy3Account @(AccountVersionFor pv)
+        return $ do
+            invariants
+            assertEqual
+                "Expected account update"
+                ( initialAccount1
+                    & Transient.accountNonce .~ 2
+                    & Transient.accountAmount -~ Helpers.energyToAmount transactionEnergy
+                )
+                updatedAccount1
+
+-- | Test that adding a baker with invalid proofs is rejected.
+testAddBakerInvalidProofs ::
+    forall pv.
+    (IsProtocolVersion pv, PVSupportsDelegation pv) =>
+    SProtocolVersion pv ->
+    String ->
+    Spec
+testAddBakerInvalidProofs _spv pvString =
+    specify (pvString ++ ": AddBaker (InvalidProofs)") $ do
+        keysWithProofsOk <- makeBakerKeysWithProofs dummy3Address 3
+        let keysWithProofs = keysWithProofsOk{bkwpSignatureVerifyKey = Sig.verifyKey $ DummyData.bakerSignKey 0}
+        let transactions =
+                [ Runner.TJSON
+                    { payload =
+                        Runner.ConfigureBaker
+                            { cbCapital = Just stakeAmount,
+                              cbRestakeEarnings = Just True,
+                              cbOpenForDelegation = Just OpenForAll,
+                              cbKeysWithProofs = Just keysWithProofs,
+                              cbMetadataURL = Just emptyUrlText,
+                              cbTransactionFeeCommission = Just (makeAmountFraction 1_000),
+                              cbBakingRewardCommission = Just (makeAmountFraction 1_000),
+                              cbFinalizationRewardCommission = Just (makeAmountFraction 1_000)
+                            },
+                      metadata = makeDummyHeader dummy3Address 1 transactionEnergy,
+                      keys = [(0, [(0, dummy3KP)])]
+                    }
+                ]
+        (result, doBlockStateAssertions) <-
+            Helpers.runSchedulerTestTransactionJson
+                Helpers.defaultTestConfig
+                (initialBlockState2 @pv)
+                (Helpers.checkReloadCheck checkState)
+                transactions
+        Helpers.assertRejectWithReason InvalidProof result
+        doBlockStateAssertions
+  where
+    stakeAmount = 20_000_000_000_000 - Helpers.energyToAmount transactionEnergy
+    -- Transaction length is 438 bytes (379 bytes for the transaction and 60 bytes for the header).
+    transactionEnergy = Cost.configureBakerCostWithKeys + Cost.baseCost 439 1
+    checkState ::
+        Helpers.SchedulerResult ->
+        BS.PersistentBlockState pv ->
+        Helpers.PersistentBSM pv Assertion
+    checkState result blockState = do
+        invariants <- Helpers.assertBlockStateInvariantsH blockState (Helpers.srExecutionCosts result)
+        updatedAccount1 <- BS.toTransientAccount . fromJust =<< BS.bsoGetAccountByIndex blockState 3
+        initialAccount1 <- BS.toTransientAccount =<< dummy3Account @(AccountVersionFor pv)
+        return $ do
+            invariants
+            assertEqual
+                "Expected account update"
+                ( initialAccount1
+                    & Transient.accountNonce .~ 2
+                    & Transient.accountAmount -~ Helpers.energyToAmount transactionEnergy
+                )
+                updatedAccount1
+
+-- | Test updating an existing baker successfully.
+testUpdateBakerOk ::
+    forall pv.
+    (IsProtocolVersion pv, PVSupportsDelegation pv) =>
+    SProtocolVersion pv ->
+    String ->
+    Spec
+testUpdateBakerOk _spv pvString =
+    specify (pvString ++ ": UpdateBaker (OK)") $ do
+        let transactions =
+                [ Runner.TJSON
+                    { payload =
+                        Runner.ConfigureBaker
+                            { cbCapital = Just stakeAmount,
+                              cbRestakeEarnings = Just True,
+                              cbOpenForDelegation = Just OpenForAll,
+                              cbKeysWithProofs = Nothing,
+                              cbMetadataURL = Just emptyUrlText,
+                              cbTransactionFeeCommission = Just (makeAmountFraction 1_000),
+                              cbBakingRewardCommission = Nothing,
+                              cbFinalizationRewardCommission = Nothing
+                            },
+                      metadata = makeDummyHeader baker4Address 1 transactionEnergy,
+                      keys = [(0, [(0, baker4KP)])]
+                    }
+                ]
+        (result, doBlockStateAssertions) <-
+            Helpers.runSchedulerTestTransactionJson
+                Helpers.defaultTestConfig
+                (initialBlockState2 @pv)
+                (Helpers.checkReloadCheck checkState)
+                transactions
+        Helpers.assertSuccessWithEvents events result
+        doBlockStateAssertions
+  where
+    stakeAmount = 10_000_000_000_000 - Helpers.energyToAmount transactionEnergy
+    events =
+        [ BakerSetRestakeEarnings
+            { ebsreBakerId = 4,
+              ebsreAccount = baker4Address,
+              ebsreRestakeEarnings = True
+            },
+          BakerSetOpenStatus
+            { ebsosBakerId = 4,
+              ebsosAccount = baker4Address,
+              ebsosOpenStatus = OpenForAll
+            },
+          BakerSetMetadataURL
+            { ebsmuBakerId = 4,
+              ebsmuAccount = baker4Address,
+              ebsmuMetadataURL = emptyUrlText
+            },
+          BakerSetTransactionFeeCommission
+            { ebstfcBakerId = 4,
+              ebstfcAccount = baker4Address,
+              ebstfcTransactionFeeCommission = makeAmountFraction 1_000
+            },
+          BakerStakeIncreased
+            { ebsiBakerId = 4,
+              ebsiAccount = baker4Address,
+              ebsiNewStake = stakeAmount
+            }
+        ]
+    -- Transaction length is 79 bytes (19 bytes for the transaction and 60 bytes for the header).
+    transactionEnergy = Cost.configureBakerCostWithoutKeys + Cost.baseCost 79 1
+    checkState ::
+        Helpers.SchedulerResult ->
+        BS.PersistentBlockState pv ->
+        Helpers.PersistentBSM pv Assertion
+    checkState result blockState = do
+        invariants <- Helpers.assertBlockStateInvariantsH blockState (Helpers.srExecutionCosts result)
+        updatedAccount1 <- BS.toTransientAccount . fromJust =<< BS.bsoGetAccountByIndex blockState 4
+        initialAccount1 <- BS.toTransientAccount =<< baker4Account @(AccountVersionFor pv)
+        return $ do
+            invariants
+            assertEqual
+                "Expected account update"
+                ( initialAccount1
+                    & Transient.accountNonce .~ 2
+                    & Transient.accountAmount -~ Helpers.energyToAmount transactionEnergy
+                    & updateStaking
+                )
+                updatedAccount1
+    updateStaking =
+        ( Transient.accountStaking . accountBaker
+            %~ (stakedAmount .~ stakeAmount)
+                . (stakeEarnings .~ True)
+                . ( accountBakerInfo . bieBakerPoolInfo
+                        %~ (poolCommissionRates . transactionCommission .~ makeAmountFraction 1_000)
+                            . (poolMetadataUrl .~ emptyUrlText)
+                  )
+        )
+    accountBaker f (AccountStakeBaker b) = AccountStakeBaker <$> f b
+    accountBaker _ x = pure x
+
+-- | Test that configuring a baker with capital this is above its balance is rejected.
+testUpdateBakerInsufficientBalance ::
+    forall pv.
+    (IsProtocolVersion pv, PVSupportsDelegation pv) =>
+    SProtocolVersion pv ->
+    String ->
+    Spec
+testUpdateBakerInsufficientBalance _spv pvString =
+    specify (pvString ++ ": UpdateBaker (Insufficient Balance)") $ do
+        let transactions =
+                [ Runner.TJSON
+                    { payload =
+                        Runner.ConfigureBaker
+                            { cbCapital = Just stakeAmount,
+                              cbRestakeEarnings = Just True,
+                              cbOpenForDelegation = Just OpenForAll,
+                              cbKeysWithProofs = Nothing,
+                              cbMetadataURL = Just emptyUrlText,
+                              cbTransactionFeeCommission = Just (makeAmountFraction 1_000),
+                              cbBakingRewardCommission = Nothing,
+                              cbFinalizationRewardCommission = Nothing
+                            },
+                      metadata = makeDummyHeader baker4Address 1 transactionEnergy,
+                      keys = [(0, [(0, baker4KP)])]
+                    }
+                ]
+        (result, doBlockStateAssertions) <-
+            Helpers.runSchedulerTestTransactionJson
+                Helpers.defaultTestConfig
+                (initialBlockState2 @pv)
+                (Helpers.checkReloadCheck checkState)
+                transactions
+        Helpers.assertRejectWithReason InsufficientBalanceForBakerStake result
+        doBlockStateAssertions
+  where
+    stakeAmount = 100_000_000_000_000 - Helpers.energyToAmount transactionEnergy
+    -- Transaction length is 79 bytes (19 bytes for the transaction and 60 bytes for the header).
+    transactionEnergy = Cost.configureBakerCostWithoutKeys + Cost.baseCost 79 1
+    checkState ::
+        Helpers.SchedulerResult ->
+        BS.PersistentBlockState pv ->
+        Helpers.PersistentBSM pv Assertion
+    checkState result blockState = do
+        invariants <- Helpers.assertBlockStateInvariantsH blockState (Helpers.srExecutionCosts result)
+        updatedAccount1 <- BS.toTransientAccount . fromJust =<< BS.bsoGetAccountByIndex blockState 4
+        initialAccount1 <- BS.toTransientAccount =<< baker4Account @(AccountVersionFor pv)
+        return $ do
+            invariants
+            assertEqual
+                "Expected account update"
+                ( initialAccount1
+                    & Transient.accountNonce .~ 2
+                    & Transient.accountAmount -~ Helpers.energyToAmount transactionEnergy
+                )
+                updatedAccount1
+
+-- | Test that configuring a baker with capital this is above its balance is rejected.
+testUpdateBakerLowStake ::
+    forall pv.
+    (IsProtocolVersion pv, PVSupportsDelegation pv) =>
+    SProtocolVersion pv ->
+    String ->
+    Spec
+testUpdateBakerLowStake _spv pvString =
+    specify (pvString ++ ": UpdateBaker (StakeUnderThreshold)") $ do
+        let transactions =
+                [ Runner.TJSON
+                    { payload =
+                        Runner.ConfigureBaker
+                            { cbCapital = Just stakeAmount,
+                              cbRestakeEarnings = Just True,
+                              cbOpenForDelegation = Just OpenForAll,
+                              cbKeysWithProofs = Nothing,
+                              cbMetadataURL = Just emptyUrlText,
+                              cbTransactionFeeCommission = Just (makeAmountFraction 1_000),
+                              cbBakingRewardCommission = Nothing,
+                              cbFinalizationRewardCommission = Nothing
+                            },
+                      metadata = makeDummyHeader baker4Address 1 transactionEnergy,
+                      keys = [(0, [(0, baker4KP)])]
+                    }
+                ]
+        (result, doBlockStateAssertions) <-
+            Helpers.runSchedulerTestTransactionJson
+                Helpers.defaultTestConfig
+                (initialBlockState2 @pv)
+                (Helpers.checkReloadCheck checkState)
+                transactions
+        Helpers.assertRejectWithReason StakeUnderMinimumThresholdForBaking result
+        doBlockStateAssertions
+  where
+    stakeAmount = 100_000
+    -- Transaction length is 79 bytes (19 bytes for the transaction and 60 bytes for the header).
+    transactionEnergy = Cost.configureBakerCostWithoutKeys + Cost.baseCost 79 1
+    checkState ::
+        Helpers.SchedulerResult ->
+        BS.PersistentBlockState pv ->
+        Helpers.PersistentBSM pv Assertion
+    checkState result blockState = do
+        invariants <- Helpers.assertBlockStateInvariantsH blockState (Helpers.srExecutionCosts result)
+        updatedAccount1 <- BS.toTransientAccount . fromJust =<< BS.bsoGetAccountByIndex blockState 4
+        initialAccount1 <- BS.toTransientAccount =<< baker4Account @(AccountVersionFor pv)
+        return $ do
+            invariants
+            assertEqual
+                "Expected account update"
+                ( initialAccount1
+                    & Transient.accountNonce .~ 2
+                    & Transient.accountAmount -~ Helpers.energyToAmount transactionEnergy
+                )
+                updatedAccount1
+
+-- | Test that configuring a baker with invalid proofs is rejected.
+testUpdateBakerInvalidProofs ::
+    forall pv.
+    (IsProtocolVersion pv, PVSupportsDelegation pv) =>
+    SProtocolVersion pv ->
+    String ->
+    Spec
+testUpdateBakerInvalidProofs _spv pvString =
+    specify (pvString ++ ": UpdateBaker (InvalidProofs)") $ do
+        -- Generate keys with challenge for a different account.
+        keysWithProofs <- makeBakerKeysWithProofs dummy3Address 912
+        let transactions =
+                [ Runner.TJSON
+                    { payload =
+                        Runner.ConfigureBaker
+                            { cbCapital = Nothing,
+                              cbRestakeEarnings = Nothing,
+                              cbOpenForDelegation = Nothing,
+                              cbKeysWithProofs = Just keysWithProofs,
+                              cbMetadataURL = Nothing,
+                              cbTransactionFeeCommission = Nothing,
+                              cbBakingRewardCommission = Nothing,
+                              cbFinalizationRewardCommission = Nothing
+                            },
+                      metadata = makeDummyHeader baker4Address 1 transactionEnergy,
+                      keys = [(0, [(0, baker4KP)])]
+                    }
+                ]
+        (result, doBlockStateAssertions) <-
+            Helpers.runSchedulerTestTransactionJson
+                Helpers.defaultTestConfig
+                (initialBlockState2 @pv)
+                (Helpers.checkReloadCheck checkState)
+                transactions
+        Helpers.assertRejectWithReason InvalidProof result
+        doBlockStateAssertions
+  where
+    -- Transaction length is 415 bytes (355 bytes for the transaction and 60 bytes for the header).
+    transactionEnergy = Cost.configureBakerCostWithKeys + Cost.baseCost 415 1
+    checkState ::
+        Helpers.SchedulerResult ->
+        BS.PersistentBlockState pv ->
+        Helpers.PersistentBSM pv Assertion
+    checkState result blockState = do
+        invariants <- Helpers.assertBlockStateInvariantsH blockState (Helpers.srExecutionCosts result)
+        updatedAccount1 <- BS.toTransientAccount . fromJust =<< BS.bsoGetAccountByIndex blockState 4
+        initialAccount1 <- BS.toTransientAccount =<< baker4Account @(AccountVersionFor pv)
+        return $ do
+            invariants
+            assertEqual
+                "Expected account update"
+                ( initialAccount1
+                    & Transient.accountNonce .~ 2
+                    & Transient.accountAmount -~ Helpers.energyToAmount transactionEnergy
+                )
+                updatedAccount1
+
+testUpdateBakerRemoveOk ::
+    forall pv.
+    (IsProtocolVersion pv, PVSupportsDelegation pv) =>
+    SProtocolVersion pv ->
+    String ->
+    Spec
+testUpdateBakerRemoveOk spv pvString =
+    specify (pvString ++ ": RemoveBaker (OK)") $ do
+        let transactions =
+                [ Runner.TJSON
+                    { payload =
+                        Runner.ConfigureBaker
+                            { cbCapital = Just 0,
+                              cbRestakeEarnings = Nothing,
+                              cbOpenForDelegation = Nothing,
+                              cbKeysWithProofs = Nothing,
+                              cbMetadataURL = Nothing,
+                              cbTransactionFeeCommission = Nothing,
+                              cbBakingRewardCommission = Nothing,
+                              cbFinalizationRewardCommission = Nothing
+                            },
+                      metadata = makeDummyHeader baker4Address 1 transactionEnergy,
+                      keys = [(0, [(0, baker4KP)])]
+                    }
+                ]
+        (result, doBlockStateAssertions) <-
+            Helpers.runSchedulerTestTransactionJson
+                Helpers.defaultTestConfig
+                (initialBlockState2 @pv)
+                (Helpers.checkReloadCheck checkState)
+                transactions
+        Helpers.assertSuccessWithEvents events result
+        doBlockStateAssertions
+  where
+    events =
+        [ BakerRemoved
+            { ebrBakerId = 4,
+              ebrAccount = baker4Address
+            }
+        ]
+    -- Transaction length is 71 bytes (11 bytes for the transaction and 60 bytes for the header).
+    transactionEnergy = Cost.configureBakerCostWithoutKeys + Cost.baseCost 71 1
+    checkState ::
+        Helpers.SchedulerResult ->
+        BS.PersistentBlockState pv ->
+        Helpers.PersistentBSM pv Assertion
+    checkState result blockState = do
+        invariants <- Helpers.assertBlockStateInvariantsH blockState (Helpers.srExecutionCosts result)
+        updatedAccount1 <- BS.toTransientAccount . fromJust =<< BS.bsoGetAccountByIndex blockState 4
+        initialAccount1 <- BS.toTransientAccount =<< baker4Account @(AccountVersionFor pv)
+        return $ do
+            invariants
+            assertEqual
+                "Expected account update"
+                ( initialAccount1
+                    & Transient.accountNonce .~ 2
+                    & Transient.accountAmount -~ Helpers.energyToAmount transactionEnergy
+                    & updateStaking
+                )
+                updatedAccount1
+    updateStaking = case sSupportsFlexibleCooldown (sAccountVersionFor spv) of
+        SFalse ->
+            Transient.accountStaking . accountBaker . bakerPendingChange
+                .~ RemoveStake (PendingChangeEffectiveV1 86400000)
+        STrue ->
+            (Transient.accountStaking .~ AccountStakeNone)
+                . (Transient.accountStakeCooldown . unconditionally .~ emptyCooldowns{prePreCooldown = Present 500_000_000_000})
+    accountBaker f (AccountStakeBaker b) = AccountStakeBaker <$> f b
+    accountBaker _ x = pure x
+
+testUpdateBakerReduceStakeOk ::
+    forall pv.
+    (IsProtocolVersion pv, PVSupportsDelegation pv) =>
+    SProtocolVersion pv ->
+    String ->
+    Spec
+testUpdateBakerReduceStakeOk spv pvString =
+    specify (pvString ++ ": UpdateBaker: ReduceStake (OK)") $ do
+        keysWithProofs <- makeBakerKeysWithProofs baker4Address 4000
+        let transactions =
+                [ Runner.TJSON
+                    { payload =
+                        Runner.ConfigureBaker
+                            { cbCapital = Just stakeAmount,
+                              cbRestakeEarnings = Nothing,
+                              cbOpenForDelegation = Nothing,
+                              cbKeysWithProofs = Just keysWithProofs,
+                              cbMetadataURL = Nothing,
+                              cbTransactionFeeCommission = Nothing,
+                              cbBakingRewardCommission = Just (makeAmountFraction 1_000),
+                              cbFinalizationRewardCommission = Just (makeAmountFraction 1_000)
+                            },
+                      metadata = makeDummyHeader baker4Address 1 transactionEnergy,
+                      keys = [(0, [(0, baker4KP)])]
+                    }
+                ]
+        (result, doBlockStateAssertions) <-
+            Helpers.runSchedulerTestTransactionJson
+                Helpers.defaultTestConfig
+                (initialBlockState2 @pv)
+                (Helpers.checkReloadCheck (checkState keysWithProofs))
+                transactions
+        Helpers.assertSuccessWithEvents (events keysWithProofs) result
+        doBlockStateAssertions
+  where
+    stakeAmount = 300_000_000_000 -- Minimum stake amount
+    events keysWithProofs =
+        [ BakerKeysUpdated
+            { ebkuBakerId = 4,
+              ebkuAccount = baker4Address,
+              ebkuSignKey = bkwpSignatureVerifyKey keysWithProofs,
+              ebkuElectionKey = bkwpElectionVerifyKey keysWithProofs,
+              ebkuAggregationKey = bkwpAggregationVerifyKey keysWithProofs
+            },
+          BakerSetBakingRewardCommission
+            { ebsbrcBakerId = 4,
+              ebsbrcAccount = baker4Address,
+              ebsbrcBakingRewardCommission = makeAmountFraction 1_000
+            },
+          BakerSetFinalizationRewardCommission
+            { ebsfrcBakerId = 4,
+              ebsfrcAccount = baker4Address,
+              ebsfrcFinalizationRewardCommission = makeAmountFraction 1_000
+            },
+          BakerStakeDecreased
+            { ebsiBakerId = 4,
+              ebsiAccount = baker4Address,
+              ebsiNewStake = stakeAmount
+            }
+        ]
+    -- Transaction length is 431 bytes (371 bytes for the transaction and 60 bytes for the header).
+    transactionEnergy = Cost.configureBakerCostWithKeys + Cost.baseCost 431 1
+    checkState ::
+        BakerKeysWithProofs ->
+        Helpers.SchedulerResult ->
+        BS.PersistentBlockState pv ->
+        Helpers.PersistentBSM pv Assertion
+    checkState keysWithProofs result blockState = do
+        invariants <- Helpers.assertBlockStateInvariantsH blockState (Helpers.srExecutionCosts result)
+        updatedAccount1 <- BS.toTransientAccount . fromJust =<< BS.bsoGetAccountByIndex blockState 4
+        initialAccount1 <- BS.toTransientAccount =<< baker4Account @(AccountVersionFor pv)
+        return $ do
+            invariants
+            assertEqual
+                "Expected account update"
+                ( initialAccount1
+                    & Transient.accountNonce .~ 2
+                    & Transient.accountAmount -~ Helpers.energyToAmount transactionEnergy
+                    & updateStaking keysWithProofs
+                )
+                updatedAccount1
+    updateStaking keysWithProofs =
+        ( case sSupportsFlexibleCooldown (sAccountVersionFor spv) of
+            SFalse ->
+                Transient.accountStaking . accountBaker
+                    %~ ( bakerPendingChange .~ ReduceStake stakeAmount (PendingChangeEffectiveV1 86400000)
+                       )
+            STrue ->
+                (Transient.accountStakeCooldown . unconditionally .~ emptyCooldowns{prePreCooldown = Present 200_000_000_000})
+                    . (Transient.accountStaking . accountBaker . stakedAmount .~ stakeAmount)
+        )
+            . ( Transient.accountStaking . accountBaker . accountBakerInfo
+                    %~ (poolCommissionRates . bakingCommission .~ makeAmountFraction 1_000)
+                        . (poolCommissionRates . finalizationCommission .~ makeAmountFraction 1_000)
+                        . (bakerElectionVerifyKey .~ bkwpElectionVerifyKey keysWithProofs)
+                        . (bakerSignatureVerifyKey .~ bkwpSignatureVerifyKey keysWithProofs)
+                        . (bakerAggregationVerifyKey .~ bkwpAggregationVerifyKey keysWithProofs)
+              )
+    accountBaker f (AccountStakeBaker b) = AccountStakeBaker <$> f b
+    accountBaker _ x = pure x
+
+tests :: Spec
+tests =
+    describe "ConfigureBaker transactions" $
+        sequence_ $
+            Helpers.forEveryProtocolVersion testCases
+  where
+    testCases :: forall pv. (IsProtocolVersion pv) => SProtocolVersion pv -> String -> Spec
+    testCases spv pvString =
+        case delegationSupport @(AccountVersionFor pv) of
+            SAVDelegationNotSupported -> return ()
+            SAVDelegationSupported -> do
+                testDelegatorToBakerOk spv pvString
+                testDelegatorToBakerDuplicateKey spv pvString
+                testDelegatorToBakerMissingParam spv pvString
+                testAddBakerOk spv pvString
+                testAddBakerInsufficientBalance spv pvString
+                testAddBakerMissingParam spv pvString
+                testAddBakerInvalidProofs spv pvString
+                testUpdateBakerOk spv pvString
+                testUpdateBakerInsufficientBalance spv pvString
+                testUpdateBakerLowStake spv pvString
+                testUpdateBakerInvalidProofs spv pvString
+                testUpdateBakerRemoveOk spv pvString
+                testUpdateBakerReduceStakeOk spv pvString
diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/Delegation.hs b/concordium-consensus/tests/scheduler/SchedulerTests/Delegation.hs
index e1fc693f5..e40da0dff 100644
--- a/concordium-consensus/tests/scheduler/SchedulerTests/Delegation.hs
+++ b/concordium-consensus/tests/scheduler/SchedulerTests/Delegation.hs
@@ -8,19 +8,18 @@
 
 -- | Test that reducing delegation and removing delegators always works, regardless
 --  of whether the new stake would violate any of the cap bounds.
---
---  This currently only tests with the basic state implementation which is not
---  ideal. The test should be expanded to also use the persistent state implementation.
 module SchedulerTests.Delegation (tests) where
 
 import Data.Bool.Singletons
 import Lens.Micro.Platform
 
+import qualified Concordium.Cost as Cost
 import qualified Concordium.Crypto.SignatureScheme as SigScheme
 import Concordium.ID.Types as ID
 import Concordium.Types.Accounts
 
 import Concordium.GlobalState.BakerInfo
+import qualified Concordium.GlobalState.Basic.BlockState.Account as Transient
 import qualified Concordium.GlobalState.BlockState as BS
 import qualified Concordium.GlobalState.Persistent.Account as BS
 import qualified Concordium.GlobalState.Persistent.BlobStore as Blob
@@ -739,8 +738,19 @@ testCase11A spv pvString =
         Helpers.SchedulerResult ->
         BS.PersistentBlockState pv ->
         Helpers.PersistentBSM pv Assertion
-    checkState result blockState =
-        Helpers.assertBlockStateInvariantsH blockState (Helpers.srExecutionCosts result)
+    checkState result blockState = do
+        invariants <- Helpers.assertBlockStateInvariantsH blockState (Helpers.srExecutionCosts result)
+        updatedBaker4 <- BS.toTransientAccount . fromJust =<< BS.bsoGetAccountByIndex blockState 4
+        initialBaker4 <- BS.toTransientAccount =<< baker4Account @(AccountVersionFor pv)
+        return $ do
+            invariants
+            assertEqual
+                "Baker account should not have changed except nonce and balance"
+                ( initialBaker4
+                    & Transient.accountNonce .~ 2
+                    & Transient.accountAmount -~ Helpers.energyToAmount (Cost.configureDelegationCost + Cost.baseCost 81 1)
+                )
+                updatedBaker4
 
 -- | Reduce stake while in cooldown.
 testCase12 ::
@@ -852,6 +862,58 @@ testCase12 spv pvString =
         SFalse ->
             return $ Helpers.assertRejectWithReason DelegatorInCooldown result
 
+-- | Change baker to delegate to itself should get rejected with
+--  `AlreadyABaker` in protocols <= P6 and `DelegationTargetNotABaker` from P7.
+testCase13 ::
+    forall pv.
+    (IsProtocolVersion pv, PVSupportsDelegation pv) =>
+    SProtocolVersion pv ->
+    String ->
+    Spec
+testCase13 spv pvString =
+    specify (pvString ++ ": Change baker to delegate to itself.") $ do
+        let transactions =
+                [ Runner.TJSON
+                    { payload =
+                        Runner.ConfigureDelegation
+                            { cdCapital = Just 1000,
+                              cdRestakeEarnings = Just False,
+                              cdDelegationTarget = Just (DelegateToBaker 4)
+                            },
+                      metadata = makeDummyHeader baker4Address 1 1_000,
+                      keys = [(0, [(0, baker4KP)])]
+                    }
+                ]
+        (result, doBlockStateAssertions) <-
+            Helpers.runSchedulerTestTransactionJson
+                Helpers.defaultTestConfig
+                (initialBlockState2 @pv)
+                (Helpers.checkReloadCheck checkState)
+                transactions
+        let reason = case sSupportsFlexibleCooldown (sAccountVersionFor spv) of
+                SFalse -> AlreadyABaker 4
+                STrue -> DelegationTargetNotABaker 4
+        Helpers.assertRejectWithReason reason result
+        doBlockStateAssertions
+  where
+    checkState ::
+        Helpers.SchedulerResult ->
+        BS.PersistentBlockState pv ->
+        Helpers.PersistentBSM pv Assertion
+    checkState result blockState = do
+        invariants <- Helpers.assertBlockStateInvariantsH blockState (Helpers.srExecutionCosts result)
+        updatedBaker4 <- BS.toTransientAccount . fromJust =<< BS.bsoGetAccountByIndex blockState 4
+        initialBaker4 <- BS.toTransientAccount =<< baker4Account @(AccountVersionFor pv)
+        return $ do
+            invariants
+            assertEqual
+                "Baker account should not have changed except nonce and balance"
+                ( initialBaker4
+                    & Transient.accountNonce .~ 2
+                    & Transient.accountAmount -~ Helpers.energyToAmount (Cost.configureDelegationCost + Cost.baseCost 81 1)
+                )
+                updatedBaker4
+
 tests :: Spec
 tests =
     describe "Delegate in different scenarios" $
@@ -877,3 +939,4 @@ tests =
                 testCase11 spv pvString
                 testCase11A spv pvString
                 testCase12 spv pvString
+                testCase13 spv pvString
diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/Helpers.hs b/concordium-consensus/tests/scheduler/SchedulerTests/Helpers.hs
index 1886d111d..e510c0a6b 100644
--- a/concordium-consensus/tests/scheduler/SchedulerTests/Helpers.hs
+++ b/concordium-consensus/tests/scheduler/SchedulerTests/Helpers.hs
@@ -137,6 +137,11 @@ forEveryProtocolVersion check =
       check Types.SP7 "P7"
     ]
 
+-- | Convert an energy value to an amount, based on the exchange rates used in
+--   'DummyData.dummyChainParameters'.
+energyToAmount :: Types.Energy -> Types.Amount
+energyToAmount = Types.computeCost (Types.makeExchangeRates 0.000_1 1_000_000 ^. Types.energyRate)
+
 -- | Construct a test block state containing the provided accounts.
 createTestBlockStateWithAccounts ::
     forall pv.
diff --git a/concordium-consensus/tests/scheduler/Spec.hs b/concordium-consensus/tests/scheduler/Spec.hs
index db6979f1d..55cedd0ea 100644
--- a/concordium-consensus/tests/scheduler/Spec.hs
+++ b/concordium-consensus/tests/scheduler/Spec.hs
@@ -4,6 +4,7 @@ import qualified SchedulerTests.AccountTransactionSpecs (tests)
 import qualified SchedulerTests.BakerTransactions (tests)
 import qualified SchedulerTests.BlockEnergyLimitSpec (tests)
 import qualified SchedulerTests.ChainMetatest (tests)
+import qualified SchedulerTests.ConfigureBaker (tests)
 import qualified SchedulerTests.Delegation (tests)
 import qualified SchedulerTests.EncryptedTransfersTest (tests)
 import qualified SchedulerTests.FibonacciSelfMessageTest (tests)
@@ -103,6 +104,7 @@ main = hspec $ do
     SchedulerTests.SmartContracts.V1.QueriesPersistent.tests
     SchedulerTests.Payday.tests
     SchedulerTests.Delegation.tests
+    SchedulerTests.ConfigureBaker.tests
     SchedulerTests.SmartContracts.V1.P6WasmFeatures.tests
     SchedulerTests.SmartContracts.V1.CustomSectionSize.tests
     SchedulerTests.SmartContracts.V1.AccountSignatureChecks.tests

From 07404443de36cea25c355234bdcbe7cee7312f32 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Mon, 26 Aug 2024 13:43:19 +0200
Subject: [PATCH 61/81] Addressing review comments.

---
 .../GlobalState/Persistent/Accounts.hs        |  6 ++---
 .../src/Concordium/Scheduler.hs               | 22 ++++++++++++++-----
 2 files changed, 19 insertions(+), 9 deletions(-)

diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs
index e737faafe..16d24ecf2 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs
@@ -420,12 +420,12 @@ updateAccountsAtIndex fupd ai a0@Accounts{..} =
         Nothing -> return (Nothing, a0)
         Just (res, act') -> return (Just res, a0{accountTable = act'})
 
--- | Set the account at the given index. There must already be an account at the given index
---  (otherwise this has no effect).
+-- | Set the account at the given index. There must already be an account at the given index.
+--  (If the account does not exist, this will throw an error.)
 setAccountAtIndex :: (SupportsPersistentAccount pv m) => AccountIndex -> PersistentAccount (AccountVersionFor pv) -> Accounts pv -> m (Accounts pv)
 setAccountAtIndex ai newAcct a0@Accounts{..} =
     L.update (const (return ((), newAcct))) ai accountTable >>= \case
-        Nothing -> return a0
+        Nothing -> error $ "setAccountAtIndex: no account at index " ++ show ai
         Just (_, act') -> return (a0{accountTable = act'})
 
 -- | Perform an update to an account with the given index.
diff --git a/concordium-consensus/src/Concordium/Scheduler.hs b/concordium-consensus/src/Concordium/Scheduler.hs
index 1309c961c..601515591 100644
--- a/concordium-consensus/src/Concordium/Scheduler.hs
+++ b/concordium-consensus/src/Concordium/Scheduler.hs
@@ -2025,13 +2025,13 @@ data ConfigureBakerCont (av :: AccountVersion)
         { -- | When flexible cooldown is supported, we can add a baker when there already is a
           --  delegator on the account, but we have to remove the delegator first. This flag indicates
           --  if there is a delegator to remove.
-          cbcRemoveDelegator :: Conditionally (SupportsFlexibleCooldown av) Bool,
+          cbcRemoveDelegator :: !(Conditionally (SupportsFlexibleCooldown av) Bool),
           -- | The parameters defining the baker to add.
-          cbcValidatorAdd :: BI.ValidatorAdd
+          cbcValidatorAdd :: !BI.ValidatorAdd
         }
     | CBCUpdate
         { -- | The parameters defining the update to the baker.
-          cbcValidatorUpdate :: BI.ValidatorUpdate
+          cbcValidatorUpdate :: !BI.ValidatorUpdate
         }
 
 -- | Check that the ownership proofs for keys used for a configure baker transaction are valid.
@@ -2044,6 +2044,7 @@ checkConfigureBakerKeys senderAddress BakerKeysWithProofs{..} =
     signP = checkSignatureVerifyKeyProof challenge bkwpSignatureVerifyKey bkwpProofSig
     aggregationP = Bls.checkProofOfKnowledgeSK challenge bkwpProofAggregation bkwpAggregationVerifyKey
 
+-- | Handler for a configure baker transaction.
 handleConfigureBaker ::
     forall m.
     ( PVSupportsDelegation (MPV m),
@@ -2148,6 +2149,8 @@ handleConfigureBaker
             chargeExecutionCost senderAccount energyCost
             result <- executeConfigure argAndBalance
             return (result, energyCost, usedEnergy)
+        -- Check the proofs are valid, if we are updating the keys.
+        -- (If there is no key update, then this is trivially 'True'.)
         proofsValid = maybe True (checkConfigureBakerKeys senderAddress) cbKeysWithProofs
         executeConfigure (CBCAdd{..}, accountBalance)
             | accountBalance < BI.vaCapital cbcValidatorAdd =
@@ -2230,15 +2233,22 @@ handleConfigureBaker
                 BI.VCFDuplicateAggregationKey key -> DuplicateAggregationKey key
                 BI.VCFChangePending -> BakerInCooldown
 
+-- | Argument to the 'withDeposit' continuation for 'handleConfigureDelegation'.
 data ConfigureDelegationCont (av :: AccountVersion)
     = CDCAdd
-        { cdcRemoveValidator :: Conditionally (SupportsFlexibleCooldown av) Bool,
-          cdcDelegatorAdd :: BI.DelegatorAdd
+        { -- | When flexible cooldown is supported, we can add a delegator when there already is
+          -- a validator on the account, but we have to remove the validator first. This flag
+          -- indicates if there is a validator to remove.
+          cdcRemoveValidator :: !(Conditionally (SupportsFlexibleCooldown av) Bool),
+          -- | The parameters defining the delegator to add.
+          cdcDelegatorAdd :: !BI.DelegatorAdd
         }
     | CDCUpdate
-        { cdcDelegatorUpdate :: BI.DelegatorUpdate
+        { -- | The parameters defining the update to the delegator.
+          cdcDelegatorUpdate :: !BI.DelegatorUpdate
         }
 
+-- | Handler for a configure delegation transaction.
 handleConfigureDelegation ::
     forall m.
     (PVSupportsDelegation (MPV m), SchedulerMonad m) =>

From 63fcde8e8fc5fa85402da56017d38183f77f2c73 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Mon, 26 Aug 2024 14:26:19 +0200
Subject: [PATCH 62/81] Set protocol update hash. Bump version.

---
 CHANGELOG.md                                                  | 2 ++
 .../src/Concordium/ProtocolUpdate/P6/ProtocolP7.hs            | 4 +---
 concordium-node/Cargo.lock                                    | 2 +-
 concordium-node/Cargo.toml                                    | 2 +-
 4 files changed, 5 insertions(+), 5 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index e339c9fe9..c7d9348ff 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -2,6 +2,8 @@
 
 ## Unreleased changes
 
+## 7.0.0
+
 - Fix a bug where `GetBakersRewardPeriod` returns incorrect data (#1176).
 - Fix a bug where `GetPoolInfo` returns incorrect data (#1177).
 - Change the severity of logs for failed gRPC API requests to DEBUG level.
diff --git a/concordium-consensus/src/Concordium/ProtocolUpdate/P6/ProtocolP7.hs b/concordium-consensus/src/Concordium/ProtocolUpdate/P6/ProtocolP7.hs
index aad1fc8bd..ff679c785 100644
--- a/concordium-consensus/src/Concordium/ProtocolUpdate/P6/ProtocolP7.hs
+++ b/concordium-consensus/src/Concordium/ProtocolUpdate/P6/ProtocolP7.hs
@@ -74,10 +74,8 @@ import Concordium.Types.ProtocolVersion
 
 -- | The hash that identifies a update from P6 to P7 protocol.
 --  This is the hash of the published specification document.
---  Currently, this it the dummy value:
---  4a875d7b7457b0f077dddeb384a059635d183e198112421e4be884e4cccec3b1
 updateHash :: SHA256.Hash
-updateHash = SHA256.hash "P6.ProtocolP7-placeholder-until-spec-hash-is-known"
+updateHash = read "e68ea0b16bbadfa5e5da768ed9afe0880bd572e29337fe6fb584f293ed7699d6"
 
 -- | Construct the genesis data for a P6.ProtocolP7 update.
 --  This takes the terminal block of the old chain which is used as the basis for constructing
diff --git a/concordium-node/Cargo.lock b/concordium-node/Cargo.lock
index 8cb19f6e6..5359987c0 100644
--- a/concordium-node/Cargo.lock
+++ b/concordium-node/Cargo.lock
@@ -787,7 +787,7 @@ dependencies = [
 
 [[package]]
 name = "concordium_node"
-version = "6.3.1"
+version = "7.0.0"
 dependencies = [
  "anyhow",
  "app_dirs2",
diff --git a/concordium-node/Cargo.toml b/concordium-node/Cargo.toml
index 7d67e6233..4aba0463b 100644
--- a/concordium-node/Cargo.toml
+++ b/concordium-node/Cargo.toml
@@ -1,6 +1,6 @@
 [package]
 name = "concordium_node"
-version = "6.3.1" # must be kept in sync with 'is_compatible_version' in 'src/configuration.rs'
+version = "7.0.0" # must be kept in sync with 'is_compatible_version' in 'src/configuration.rs'
 description = "Concordium Node"
 authors = ["Concordium <developers@concordium.com>"]
 exclude = [".gitignore", ".gitlab-ci.yml", "test/**/*","**/**/.gitignore","**/**/.gitlab-ci.yml"]

From b53dfb06e9500b69fda47977c99d7697ab9d9a00 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Mon, 26 Aug 2024 14:58:59 +0200
Subject: [PATCH 63/81] Bump base.

---
 concordium-base            | 2 +-
 concordium-node/Cargo.lock | 4 ++--
 2 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/concordium-base b/concordium-base
index 7bd626d97..05d042587 160000
--- a/concordium-base
+++ b/concordium-base
@@ -1 +1 @@
-Subproject commit 7bd626d9736b4744870dec96559fd87f7d4308ed
+Subproject commit 05d042587256422302b865a34966c96625318d97
diff --git a/concordium-node/Cargo.lock b/concordium-node/Cargo.lock
index 5359987c0..40eae7505 100644
--- a/concordium-node/Cargo.lock
+++ b/concordium-node/Cargo.lock
@@ -670,7 +670,7 @@ dependencies = [
 
 [[package]]
 name = "concordium-contracts-common"
-version = "9.1.0"
+version = "9.2.0"
 dependencies = [
  "base64 0.21.7",
  "bs58",
@@ -732,7 +732,7 @@ dependencies = [
 
 [[package]]
 name = "concordium_base"
-version = "5.0.0"
+version = "6.0.0"
 dependencies = [
  "aes",
  "anyhow",

From e9b98bb7761c1fc3a3b0c3c7f91c266acc28037f Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Tue, 27 Aug 2024 10:52:59 +0200
Subject: [PATCH 64/81] Update submodule

---
 concordium-base | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/concordium-base b/concordium-base
index 05d042587..8c925efc1 160000
--- a/concordium-base
+++ b/concordium-base
@@ -1 +1 @@
-Subproject commit 05d042587256422302b865a34966c96625318d97
+Subproject commit 8c925efc17405cc2927f20df46ed5b57275840c2

From ddf852e9d0e9805214b71dcaae7412ba50c899be Mon Sep 17 00:00:00 2001
From: Victor Nordam Suadicani <vs@concordium.com>
Date: Thu, 5 Sep 2024 13:13:46 +0200
Subject: [PATCH 65/81] Fix consensus not recognizing P7 update

---
 .../src/Concordium/ProtocolUpdate/V1.hs            | 14 +++++++++++++-
 1 file changed, 13 insertions(+), 1 deletion(-)

diff --git a/concordium-consensus/src/Concordium/ProtocolUpdate/V1.hs b/concordium-consensus/src/Concordium/ProtocolUpdate/V1.hs
index 0d5d0d3f5..d18f85fdb 100644
--- a/concordium-consensus/src/Concordium/ProtocolUpdate/V1.hs
+++ b/concordium-consensus/src/Concordium/ProtocolUpdate/V1.hs
@@ -18,19 +18,29 @@ import qualified Concordium.GlobalState.Types as GSTypes
 import Concordium.KonsensusV1.TreeState.Implementation
 import Concordium.KonsensusV1.TreeState.Types
 import qualified Concordium.ProtocolUpdate.P6 as P6
+import qualified Concordium.ProtocolUpdate.P7 as P7
 
 -- | Type representing currently supported protocol update types.
 data Update (pv :: ProtocolVersion) where
     UpdateP6 :: P6.Update -> Update 'P6
+    UpdateP7 :: P7.Update -> Update 'P7
 
 instance Show (Update pv) where
     show (UpdateP6 u) = "P6." ++ show u
+    show (UpdateP7 u) = "P7." ++ show u
 
 -- | Determine if a 'ProtocolUpdate' corresponds to a supported update type.
 checkUpdate :: forall pv. (IsProtocolVersion pv) => ProtocolUpdate -> Either String (Update pv)
 checkUpdate = case protocolVersion @pv of
+    -- These ones are only supported in V0.
+    SP1 -> const $ Left "Update to P1 unsupported in V1."
+    SP2 -> const $ Left "Update to P2 unsupported in V1."
+    SP3 -> const $ Left "Update to P3 unsupported in V1."
+    SP4 -> const $ Left "Update to P4 unsupported in V1."
+    SP5 -> const $ Left "Update to P5 unsupported in V1."
+    -- These ones are supported in V1.
     SP6 -> fmap UpdateP6 . P6.checkUpdate
-    _ -> const $ Left "Unsupported update."
+    SP7 -> fmap UpdateP7 . P7.checkUpdate
 
 -- | Construct the genesis data for a P1 update.
 updateRegenesis ::
@@ -44,6 +54,7 @@ updateRegenesis ::
     BlockPointer (MPV m) ->
     m (PVInit m)
 updateRegenesis (UpdateP6 u) = P6.updateRegenesis u
+updateRegenesis (UpdateP7 u) = P7.updateRegenesis u
 
 -- | Determine the next protocol version for the given update. Although the same
 --  information can be retrieved from 'updateRegenesis', this is more efficient
@@ -52,3 +63,4 @@ updateNextProtocolVersion ::
     Update pv ->
     SomeProtocolVersion
 updateNextProtocolVersion (UpdateP6 u) = P6.updateNextProtocolVersion u
+updateNextProtocolVersion (UpdateP7 u) = P7.updateNextProtocolVersion u

From 8fbfba04f2877f43377918a77a65bfd673179155 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Fri, 6 Sep 2024 15:47:07 +0200
Subject: [PATCH 66/81] Modify test to exercise account migration bug.

---
 .../AccountsMigrationP6ToP7.hs                | 28 ++++++++++++++-----
 1 file changed, 21 insertions(+), 7 deletions(-)

diff --git a/concordium-consensus/tests/globalstate/GlobalStateTests/AccountsMigrationP6ToP7.hs b/concordium-consensus/tests/globalstate/GlobalStateTests/AccountsMigrationP6ToP7.hs
index 81674183a..47b4436bb 100644
--- a/concordium-consensus/tests/globalstate/GlobalStateTests/AccountsMigrationP6ToP7.hs
+++ b/concordium-consensus/tests/globalstate/GlobalStateTests/AccountsMigrationP6ToP7.hs
@@ -28,6 +28,7 @@ import Concordium.Types.Accounts
 
 import qualified Concordium.Crypto.BlockSignature as Sig
 import qualified Concordium.Crypto.BlsSignature as Bls
+import Concordium.Crypto.EncryptedTransfers
 import qualified Concordium.Crypto.VRF as VRF
 import Concordium.Genesis.Data
 import Concordium.GlobalState.Account
@@ -75,6 +76,14 @@ dummyPersisingAccountData seed =
     addr = accountAddressFromSeed seed
     encryptionKey = toRawEncryptionKey (makeEncryptionKey dummyCryptographicParameters (credId cred))
 
+-- | A dummy account encrypted amount, with a non-trivial self balance.
+-- This is used to test the migration of accounts with non-trivial encrypted balances.
+dummyAccountEncryptedAmount :: AccountEncryptedAmount
+dummyAccountEncryptedAmount =
+    initialAccountEncryptedAmount
+        { _selfAmount = encryptAmountZeroRandomness dummyCryptographicParameters 10
+        }
+
 -- | Create a test account with the given persisting data and stake.
 --  The balance of the account is set to 1 billion CCD (10^15 uCCD).
 testAccount ::
@@ -88,7 +97,7 @@ testAccount persisting stake =
         { _accountPersisting = Transient.makeAccountPersisting persisting,
           _accountNonce = minNonce,
           _accountAmount = 1_000_000_000_000_000,
-          _accountEncryptedAmount = initialAccountEncryptedAmount,
+          _accountEncryptedAmount = dummyAccountEncryptedAmount,
           _accountReleaseSchedule = Transient.emptyAccountReleaseSchedule,
           _accountStaking = stake,
           _accountStakeCooldown = Transient.emptyCooldownQueue (accountVersion @av)
@@ -198,10 +207,13 @@ setupTestAccounts = do
             (ReduceStake (reducedStake 13) (PendingChangeEffectiveV1 9000))
     a14 <- mkDelegatorAccount 14 DelegatePassive (RemoveStake (PendingChangeEffectiveV1 10_000))
     accounts0 <- emptyAccounts
-    foldM
-        (\accts a -> snd <$> putNewAccount a accts)
-        accounts0
-        [a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14]
+    accounts1 <-
+        foldM
+            (\accts a -> snd <$> putNewAccount a accts)
+            accounts0
+            [a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14]
+    -- Store and load the accounts to ensure the data is flushed.
+    loadRef =<< storeRef accounts1
   where
     mkBakerAccount accIdx pc =
         makePersistentAccount $
@@ -359,8 +371,10 @@ tests = describe "GlobalStateTests.AccountsMigrationP6ToP7"
   where
     createPBSC dir i = do
         pbscBlobStore <- createBlobStore (dir </> ("blockstate" ++ i ++ ".dat"))
-        pbscAccountCache <- newAccountCache 100
-        pbscModuleCache <- M.newModuleCache 100
+        -- Set the account cache size to 0 to ensure that the accounts are always loaded from the
+        -- blob store.
+        pbscAccountCache <- newAccountCache 0
+        pbscModuleCache <- M.newModuleCache 0
         pbscAccountMap <- LMDBAccountMap.openDatabase (dir </> ("accountmap" ++ i))
         return PersistentBlockStateContext{..}
     destroyPBSC PersistentBlockStateContext{..} = do

From e3519c2ab831aec918995244d41c091b50378183 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Fri, 6 Sep 2024 16:42:13 +0200
Subject: [PATCH 67/81] Fix account migration.

---
 .../GlobalState/Persistent/Account.hs         |  4 +-
 .../Persistent/Account/MigrationState.hs      |  4 +-
 .../Persistent/Account/StructureV1.hs         | 94 ++++++++++++++-----
 .../GlobalState/Persistent/Accounts.hs        |  7 +-
 .../GlobalState/Persistent/BlobStore.hs       |  8 +-
 .../GlobalState/Persistent/BlockState.hs      | 15 ++-
 6 files changed, 105 insertions(+), 27 deletions(-)

diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs
index c912a38cf..464c88605 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs
@@ -35,6 +35,7 @@ import qualified Concordium.GlobalState.Persistent.Account.StructureV1 as V1
 import Concordium.GlobalState.Persistent.BlobStore
 import Concordium.GlobalState.Persistent.Cache
 import Concordium.GlobalState.Persistent.CachedRef
+import Concordium.Logger
 
 -- * Account types
 
@@ -659,7 +660,8 @@ migratePersistentAccount ::
     ( IsProtocolVersion oldpv,
       IsProtocolVersion pv,
       SupportMigration m t,
-      AccountMigration (AccountVersionFor pv) (t m)
+      AccountMigration (AccountVersionFor pv) (t m),
+      MonadLogger (t m)
     ) =>
     StateMigrationParameters oldpv pv ->
     PersistentAccount (AccountVersionFor oldpv) ->
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationState.hs
index 5f37aa5fd..e7ccbfd1b 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/MigrationState.hs
@@ -19,6 +19,7 @@ import Data.Kind
 import Data.Maybe
 import Lens.Micro.Platform
 
+import Concordium.Logger
 import Concordium.Types
 import Concordium.Types.Accounts
 import Concordium.Types.Conditionally
@@ -178,7 +179,8 @@ newtype
           Monad,
           MonadState (AccountMigrationState oldpv pv),
           MonadIO,
-          LMDBAccountMap.MonadAccountMapStore
+          LMDBAccountMap.MonadAccountMapStore,
+          MonadLogger
         )
 
 -- | Run an 'AccountMigrationStateTT' computation with the given initial state.
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
index 4ad1da020..f1777b8e1 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs
@@ -1,9 +1,11 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE BinaryLiterals #-}
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 -- We suppress redundant constraint warnings since GHC does not detect when a constraint is used
@@ -16,11 +18,13 @@
 module Concordium.GlobalState.Persistent.Account.StructureV1 where
 
 import Control.Monad
+import qualified Control.Monad.State.Class as State
 import Control.Monad.Trans
-import qualified Control.Monad.Trans.State.Strict as State
+import qualified Control.Monad.Trans.State.Strict as State (StateT (..))
 import Data.Bits
 import Data.Bool.Singletons
 import Data.Foldable
+import Data.Kind
 import qualified Data.Map.Strict as Map
 import Data.Serialize
 import Data.Word
@@ -29,6 +33,7 @@ import Lens.Micro.Platform
 import qualified Concordium.Crypto.SHA256 as Hash
 import Concordium.Genesis.Data
 import Concordium.ID.Types hiding (values)
+import Concordium.Logger
 import Concordium.Types
 import Concordium.Types.Accounts
 import Concordium.Types.Accounts.Releases
@@ -206,8 +211,42 @@ migratePersistentAccountStakeEnduring PersistentAccountStakeEnduringBaker{..} =
 migratePersistentAccountStakeEnduring PersistentAccountStakeEnduringDelegator{..} =
     return $! PersistentAccountStakeEnduringDelegator{..}
 
+-- | A monad transformer transformer that left-composes @StateT Amount@
+--  with a given monad transformer @t@. The purpose of this is to add state functionality for
+--  tracking the current active stake on an account, which is used when migrating an account
+--  between certain protocol versions.
+--
+--  A monad transformer transformer is used so that the 'lift' operation removes both the
+--  @StateT Amount@ and the underlying monad transformer @t@. This is important as the reference
+--  migration functions depend on using 'lift' to access the source block state.
+newtype StakedBalanceStateTT (t :: (Type -> Type) -> (Type -> Type)) (m :: Type -> Type) (a :: Type) = StakedBalanceStateTT
+    { runStakedBalanceStateTT' :: State.StateT Amount (t m) a
+    }
+    deriving newtype (Functor, Applicative, Monad, State.MonadState Amount, MonadIO, MonadLogger)
+
+-- | Run an 'StakedBalanceStateTT' computation with the given initial staked balance state.
+runStakedBalanceStateTT :: StakedBalanceStateTT t m a -> Amount -> t m (a, Amount)
+runStakedBalanceStateTT = State.runStateT . runStakedBalanceStateTT'
+
+instance (MonadTrans t) => MonadTrans (StakedBalanceStateTT t) where
+    lift = StakedBalanceStateTT . lift . lift
+
+deriving via
+    forall (t :: (Type -> Type) -> (Type -> Type)) (m :: Type -> Type).
+    State.StateT Amount (t m)
+    instance
+        (MonadBlobStore (t m)) =>
+        MonadBlobStore (StakedBalanceStateTT t m)
+
+-- | Lift a computation in the base monad to the transformed monad.
+liftStakedBalanceStateTT ::
+    (Monad (t m)) =>
+    t m a ->
+    StakedBalanceStateTT t m a
+liftStakedBalanceStateTT = StakedBalanceStateTT . lift
+
 -- | Migrate a 'PersistentAccountStakeEnduring' from 'AccountV2' to 'AccountV3'.  This runs in the
---   'StateT' monad, where the state is the amount of active stake on the account.
+--   @StakedBalanceStateTT t m@ monad, where the state is the amount of active stake on the account.
 --
 --   * If there is a pending change on the account, then the pending change is removed and the
 --     active stake is updated to apply the pending change. The change in the stake is moved to
@@ -225,7 +264,7 @@ migratePersistentAccountStakeEnduringV2toV3 ::
     (SupportMigration m t, AccountMigration 'AccountV3 (t m)) =>
     PersistentAccountStakeEnduring 'AccountV2 ->
     -- | Returns the new 'PersistentAccountStakeEnduring' and 'CooldownQueue'.
-    State.StateT Amount (t m) (PersistentAccountStakeEnduring 'AccountV3, CooldownQueue 'AccountV3)
+    StakedBalanceStateTT t m (PersistentAccountStakeEnduring 'AccountV3, CooldownQueue 'AccountV3)
 migratePersistentAccountStakeEnduringV2toV3 PersistentAccountStakeEnduringNone =
     return (PersistentAccountStakeEnduringNone, emptyCooldownQueue)
 migratePersistentAccountStakeEnduringV2toV3 PersistentAccountStakeEnduringBaker{..} =
@@ -236,7 +275,7 @@ migratePersistentAccountStakeEnduringV2toV3 PersistentAccountStakeEnduringBaker{
             cooldownAmount <- State.get
             State.put 0
             cooldown <- initialPrePreCooldownQueue cooldownAmount
-            lift addAccountInPrePreCooldown
+            liftStakedBalanceStateTT addAccountInPrePreCooldown
             return (PersistentAccountStakeEnduringNone, cooldown)
         ReduceStake newStake _ -> do
             oldStake <- State.get
@@ -248,7 +287,7 @@ migratePersistentAccountStakeEnduringV2toV3 PersistentAccountStakeEnduringBaker{
                         ++ show newStake
             State.put newStake
             cooldown <- initialPrePreCooldownQueue (oldStake - newStake)
-            lift addAccountInPrePreCooldown
+            liftStakedBalanceStateTT addAccountInPrePreCooldown
             newPASE <- keepBakerInfo
             return (newPASE, cooldown)
         NoChange -> (,emptyCooldownQueue) <$> keepBakerInfo
@@ -268,13 +307,13 @@ migratePersistentAccountStakeEnduringV2toV3 PersistentAccountStakeEnduringDelega
             cooldownAmount <- State.get
             State.put 0
             cooldown <- initialPrePreCooldownQueue cooldownAmount
-            lift addAccountInPrePreCooldown
+            liftStakedBalanceStateTT addAccountInPrePreCooldown
             return (PersistentAccountStakeEnduringNone, cooldown)
         _ -> do
             newTarget <- case paseDelegatorTarget of
                 DelegatePassive -> return DelegatePassive
                 DelegateToBaker bid -> do
-                    removed <- lift $ isBakerRemoved bid
+                    removed <- liftStakedBalanceStateTT $ isBakerRemoved bid
                     return $ if removed then DelegatePassive else paseDelegatorTarget
             let newDelegatorInfo =
                     PersistentAccountStakeEnduringDelegator
@@ -295,12 +334,12 @@ migratePersistentAccountStakeEnduringV2toV3 PersistentAccountStakeEnduringDelega
                                 ++ show newStake
                     State.put newStake
                     cooldown <- initialPrePreCooldownQueue (oldStake - newStake)
-                    lift $ do
+                    liftStakedBalanceStateTT $ do
                         addAccountInPrePreCooldown
                         retainDelegator paseDelegatorId newStake newTarget
                     return $!! (newDelegatorInfo, cooldown)
                 NoChange -> do
-                    lift $ retainDelegator paseDelegatorId oldStake newTarget
+                    liftStakedBalanceStateTT $ retainDelegator paseDelegatorId oldStake newTarget
                     return $!! (newDelegatorInfo, emptyCooldownQueue)
 
 -- | This relies on the fact that the 'AccountV2' hashing of 'AccountStake' is independent of the
@@ -1752,7 +1791,7 @@ makeFromGenesisAccount spv cryptoParams chainParameters GenesisAccount{..} = do
 -- ** Migration
 
 migrateEnduringDataV2 ::
-    (SupportMigration m t) =>
+    (SupportMigration m t, MonadLogger (t m)) =>
     PersistentAccountEnduringData 'AccountV2 ->
     t m (PersistentAccountEnduringData 'AccountV2)
 migrateEnduringDataV2 ed = do
@@ -1769,8 +1808,8 @@ migrateEnduringDataV2 ed = do
               ..
             }
 
--- | Migrate enduring data from 'AccountV2' to 'AccountV3'. The 'Amount' in the 'State.StateT'
---  represents the current active stake on the account.
+-- | Migrate enduring data from 'AccountV2' to 'AccountV3'. This uses 'StakedBalanceStateTT' to
+--  track the staked balance of the account.
 --
 --   * If the account previously had a pending change, it will now have a pre-pre-cooldown, and
 --     'addAccountInPrePreCooldown' is called (to register this globally). If the pending change
@@ -1783,18 +1822,24 @@ migrateEnduringDataV2 ed = do
 --   * If the account is still delegating, 'retainDelegator' is called to record the (new)
 --     delegation amount and target globally.
 migrateEnduringDataV2toV3 ::
-    (SupportMigration m t, AccountMigration 'AccountV3 (t m)) =>
+    (SupportMigration m t, AccountMigration 'AccountV3 (t m), MonadLogger (t m)) =>
     -- | Current enduring data
     PersistentAccountEnduringData 'AccountV2 ->
     -- | New enduring data.
-    State.StateT Amount (t m) (PersistentAccountEnduringData 'AccountV3)
+    StakedBalanceStateTT t m (PersistentAccountEnduringData 'AccountV3)
 migrateEnduringDataV2toV3 ed = do
+    logEvent GlobalState LLTrace "Migrating persisting data"
     paedPersistingData <- migrateEagerBufferedRef return (paedPersistingData ed)
-    paedEncryptedAmount <- forM (paedEncryptedAmount ed) $ migrateReference migratePersistentEncryptedAmount
+    paedEncryptedAmount <- forM (paedEncryptedAmount ed) $ \e -> do
+        logEvent GlobalState LLTrace "Migrating encrypted amount"
+        migrateReference migratePersistentEncryptedAmount e
     paedReleaseSchedule <- forM (paedReleaseSchedule ed) $ \(oldRSRef, lockedAmt) -> do
+        logEvent GlobalState LLTrace "Migrating release schedule"
         newRSRef <- migrateReference migrateAccountReleaseSchedule oldRSRef
         return (newRSRef, lockedAmt)
+    logEvent GlobalState LLTrace "Migrating stake"
     (paedStake, paedStakeCooldown) <- migratePersistentAccountStakeEnduringV2toV3 (paedStake ed)
+    logEvent GlobalState LLTrace "Reconstructing account enduring data"
     makeAccountEnduringDataAV3
         paedPersistingData
         paedEncryptedAmount
@@ -1805,7 +1850,7 @@ migrateEnduringDataV2toV3 ed = do
 -- | Migration for 'PersistentAccountEnduringData'. Only supports 'AccountV3'.
 --  The data is unchanged in the migration.
 migrateEnduringDataV3toV3 ::
-    (SupportMigration m t) =>
+    (SupportMigration m t, MonadLogger (t m)) =>
     PersistentAccountEnduringData 'AccountV3 ->
     t m (PersistentAccountEnduringData 'AccountV3)
 migrateEnduringDataV3toV3 ed = do
@@ -1823,7 +1868,8 @@ migrateEnduringDataV3toV3 ed = do
 migrateV2ToV2 ::
     ( MonadBlobStore m,
       MonadBlobStore (t m),
-      MonadTrans t
+      MonadTrans t,
+      MonadLogger (t m)
     ) =>
     PersistentAccount 'AccountV2 ->
     t m (PersistentAccount 'AccountV2)
@@ -1857,13 +1903,14 @@ migrateV2ToV3 ::
     ( MonadBlobStore m,
       MonadBlobStore (t m),
       AccountMigration 'AccountV3 (t m),
-      MonadTrans t
+      MonadTrans t,
+      MonadLogger (t m)
     ) =>
     PersistentAccount 'AccountV2 ->
     t m (PersistentAccount 'AccountV3)
 migrateV2ToV3 acc = do
     (accountEnduringData, newStakedAmount) <-
-        State.runStateT
+        runStakedBalanceStateTT
             (migrateEagerBufferedRef migrateEnduringDataV2toV3 (accountEnduringData acc))
             (accountStakedAmount acc)
     return $!
@@ -1879,7 +1926,8 @@ migrateV2ToV3 acc = do
 migrateV3ToV3 ::
     ( MonadBlobStore m,
       MonadBlobStore (t m),
-      MonadTrans t
+      MonadTrans t,
+      MonadLogger (t m)
     ) =>
     PersistentAccount 'AccountV3 ->
     t m (PersistentAccount 'AccountV3)
@@ -1913,7 +1961,8 @@ migratePersistentAccount ::
     ( IsProtocolVersion oldpv,
       SupportMigration m t,
       AccountMigration (AccountVersionFor pv) (t m),
-      AccountStructureVersionFor (AccountVersionFor oldpv) ~ 'AccountStructureV1
+      AccountStructureVersionFor (AccountVersionFor oldpv) ~ 'AccountStructureV1,
+      MonadLogger (t m)
     ) =>
     StateMigrationParameters oldpv pv ->
     PersistentAccount (AccountVersionFor oldpv) ->
@@ -1929,7 +1978,8 @@ migratePersistentAccount StateMigrationParametersP6ToP7{} acc = migrateV2ToV3 ac
 migratePersistentAccountFromV0 ::
     ( SupportMigration m t,
       AccountVersionFor oldpv ~ 'AccountV1,
-      AccountVersionFor pv ~ 'AccountV2
+      AccountVersionFor pv ~ 'AccountV2,
+      MonadLogger (t m)
     ) =>
     StateMigrationParameters oldpv pv ->
     V0.PersistentAccount (AccountVersionFor oldpv) ->
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs
index 16d24ecf2..908fe9e75 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs
@@ -75,6 +75,7 @@ import Concordium.GlobalState.Persistent.LFMBTree (LFMBTree', LFMBTreeHash, LFMB
 import qualified Concordium.GlobalState.Persistent.LFMBTree as L
 import qualified Concordium.GlobalState.Persistent.Trie as Trie
 import qualified Concordium.ID.Types as ID
+import Concordium.Logger
 import Concordium.Types
 import Concordium.Types.HashableTo
 import Concordium.Types.Option (Option (..))
@@ -500,13 +501,17 @@ migrateAccounts ::
       SupportMigration m t,
       SupportsPersistentAccount oldpv m,
       SupportsPersistentAccount pv (t m),
-      AccountsMigration (AccountVersionFor pv) (t m)
+      AccountsMigration (AccountVersionFor pv) (t m),
+      MonadLogger (t m)
     ) =>
     StateMigrationParameters oldpv pv ->
     Accounts oldpv ->
     t m (Accounts pv)
 migrateAccounts migration Accounts{..} = do
+    logEvent GlobalState LLTrace "Migrating accounts"
     let migrateAccount acct = do
+            canonicalAddress <- accountCanonicalAddress =<< lift (refLoad acct)
+            logEvent GlobalState LLTrace $ "Migrating account: " <> show canonicalAddress
             newAcct <- migrateHashedCachedRef' (migratePersistentAccount migration) acct
             -- Increment the account index counter.
             nextAccount
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlobStore.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlobStore.hs
index 8428f409e..b01095a17 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlobStore.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlobStore.hs
@@ -373,7 +373,13 @@ readBlobBSFromHandle BlobStoreAccess{..} (BlobRef offset) = mask $ \restore -> d
             Right size
                 | offset + 8 + size <= fromIntegral bhSize ->
                     BS.hGet bhHandle (fromIntegral size)
-            _ -> throwIO $ userError "Attempted to read beyond the blob store end"
+            _ ->
+                throwIO $
+                    userError $
+                        "Attempted to read beyond the blob store end @"
+                            ++ show offset
+                            ++ " in file "
+                            ++ blobStoreFilePath
     putMVar blobStoreFile bh{bhAtEnd = False}
     case eres :: Either SomeException BS.ByteString of
         Left e -> throwIO e
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
index 267dd1023..b04248360 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
@@ -78,7 +78,7 @@ import qualified Concordium.GlobalState.Wasm as GSWasm
 import qualified Concordium.ID.Parameters as ID
 import qualified Concordium.ID.Types as ID
 import Concordium.Kontrol.Bakers
-import Concordium.Logger (MonadLogger)
+import Concordium.Logger
 import Concordium.TimeMonad (TimeMonad)
 import Concordium.Types
 import Concordium.Types.Accounts (AccountBaker (..))
@@ -4436,40 +4436,53 @@ migrateBlockPointers migration BlockStatePointers{..} = do
                     Just ai -> ai
             StateMigrationParametersP5ToP6{} -> RSMNewToNew
             StateMigrationParametersP6ToP7{} -> RSMNewToNew
+    logEvent GlobalState LLTrace "Migrating release schedule"
     newReleaseSchedule <- migrateReleaseSchedule rsMigration bspReleaseSchedule
     pab <- lift . refLoad $ bspBirkParameters ^. birkActiveBakers
     -- When we migrate the accounts, we accumulate state
     initMigrationState :: MigrationState.AccountMigrationState oldpv pv <-
         MigrationState.makeInitialAccountMigrationState bspAccounts pab
+    logEvent GlobalState LLTrace "Migrating accounts"
     (newAccounts, migrationState) <-
         MigrationState.runAccountMigrationStateTT
             (Accounts.migrateAccounts migration bspAccounts)
             initMigrationState
+    logEvent GlobalState LLTrace "Migrating accounts in cooldown"
     newAccountsInCooldown <-
         migrateAccountsInCooldownForPV
             (MigrationState._migrationPrePreCooldown migrationState)
             bspAccountsInCooldown
+    logEvent GlobalState LLTrace "Migrating modules"
     newModules <- migrateHashedBufferedRef (Modules.migrateModules migration) bspModules
     modules <- refLoad newModules
+    logEvent GlobalState LLTrace "Migrating contract instances"
     newInstances <- Instances.migrateInstances modules bspInstances
     let newBank = bspBank
+    logEvent GlobalState LLTrace "Migrating identity providers"
     newIdentityProviders <- migrateHashedBufferedRefKeepHash bspIdentityProviders
+    logEvent GlobalState LLTrace "Migrating anonymity revokers"
     newAnonymityRevokers <- migrateHashedBufferedRefKeepHash bspAnonymityRevokers
     let oldEpoch = bspBirkParameters ^. birkSeedState . epoch
+    logEvent GlobalState LLTrace "Migrating Birk parameters"
     newBirkParameters <-
         migratePersistentBirkParameters
             migration
             newAccounts
             (MigrationState._persistentActiveBakers migrationState)
             bspBirkParameters
+    logEvent GlobalState LLTrace "Migrating cryptographic parameters"
     newCryptographicParameters <- migrateHashedBufferedRefKeepHash bspCryptographicParameters
+    logEvent GlobalState LLTrace "Migrating chain parameters and updates updates"
     newUpdates <- migrateReference (migrateUpdates migration) bspUpdates
+    logEvent GlobalState LLTrace "Migrating current epoch bakers"
     curBakers <- extractBakerStakes =<< refLoad (_birkCurrentEpochBakers newBirkParameters)
+    logEvent GlobalState LLTrace "Migrating next epoch bakers"
     nextBakers <- extractBakerStakes =<< refLoad (_birkNextEpochBakers newBirkParameters)
     -- clear transaction outcomes.
     let newTransactionOutcomes = emptyTransactionOutcomes (Proxy @pv)
     chainParams <- refLoad . currentParameters =<< refLoad newUpdates
     let timeParams = _cpTimeParameters . unStoreSerialized $ chainParams
+    logEvent GlobalState LLTrace "Migrating reward details"
     newRewardDetails <-
         migrateBlockRewardDetails migration curBakers nextBakers timeParams oldEpoch bspRewardDetails
 

From 503899414723b02986081279c3246eded839c5c5 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Mon, 9 Sep 2024 10:58:54 +0200
Subject: [PATCH 68/81] Update changelog. Bump version for release.

---
 CHANGELOG.md               | 5 +++++
 concordium-node/Cargo.toml | 2 +-
 2 files changed, 6 insertions(+), 1 deletion(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index c7d9348ff..0375af7f2 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -2,6 +2,11 @@
 
 ## Unreleased changes
 
+## 7.0.1
+
+- Fix a bug in migration from protocol version 6 to 7.
+- Support "reboot" protocol update at protocol version 7.
+
 ## 7.0.0
 
 - Fix a bug where `GetBakersRewardPeriod` returns incorrect data (#1176).
diff --git a/concordium-node/Cargo.toml b/concordium-node/Cargo.toml
index 4aba0463b..fb1665939 100644
--- a/concordium-node/Cargo.toml
+++ b/concordium-node/Cargo.toml
@@ -1,6 +1,6 @@
 [package]
 name = "concordium_node"
-version = "7.0.0" # must be kept in sync with 'is_compatible_version' in 'src/configuration.rs'
+version = "7.0.1" # must be kept in sync with 'is_compatible_version' in 'src/configuration.rs'
 description = "Concordium Node"
 authors = ["Concordium <developers@concordium.com>"]
 exclude = [".gitignore", ".gitlab-ci.yml", "test/**/*","**/**/.gitignore","**/**/.gitlab-ci.yml"]

From 29b43bbc23b103fdbf7e1d72d3a0751e64e55147 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Wed, 11 Sep 2024 11:08:57 +0200
Subject: [PATCH 69/81] Fix handling of consensus exceptions.

---
 .../src-lib/Concordium/External.hs            |  19 +-
 .../src/Concordium/KonsensusV1/SkovMonad.hs   |  15 +-
 .../src/Concordium/MultiVersion.hs            | 214 ++++++++++++------
 .../src/Concordium/Skov/Monad.hs              |   2 +
 concordium-node/Cargo.lock                    |   2 +-
 concordium-node/src/consensus_ffi/ffi.rs      |  12 +-
 concordium-node/src/consensus_ffi/helpers.rs  |  14 +-
 7 files changed, 188 insertions(+), 90 deletions(-)

diff --git a/concordium-consensus/src-lib/Concordium/External.hs b/concordium-consensus/src-lib/Concordium/External.hs
index dbe8c98d7..ef0ff94fb 100644
--- a/concordium-consensus/src-lib/Concordium/External.hs
+++ b/concordium-consensus/src-lib/Concordium/External.hs
@@ -726,7 +726,7 @@ stopBaker cptr = mask_ $ do
 -- |    16 | ResultNonexistingSenderAccount              | The transaction's sender account does not exist according to the focus block                  | No       |
 -- +-------+---------------------------------------------+-----------------------------------------------------------------------------------------------+----------+
 -- |    17 | ResultDuplicateNonce                        | The sequence number for this account or update type was already used                          | No       |
--- i+-------+---------------------------------------------+-----------------------------------------------------------------------------------------------+----------+
+-- +-------+---------------------------------------------+-----------------------------------------------------------------------------------------------+----------+
 -- |    18 | ResultNonceTooLarge                         | The transaction seq. number is larger than the next one for this account/update type          | No       |
 -- +-------+---------------------------------------------+-----------------------------------------------------------------------------------------------+----------+
 -- |    19 | ResultTooLowEnergy                          | The stated transaction energy is lower than the minimum amount necessary to execute it        | No       |
@@ -755,6 +755,8 @@ stopBaker cptr = mask_ $ do
 -- +-------+---------------------------------------------+-----------------------------------------------------------------------------------------------+----------+
 -- |    31 | ResultDoubleSign                            | The consensus message is a result of malignant double signing.                                | No       |
 -- +-------+---------------------------------------------+-----------------------------------------------------------------------------------------------+----------+
+-- |    32 | ResultConsensusFailure                      | The consensus has thrown an exception and entered an unrecoverable state.                     | No       |
+-- +-------+---------------------------------------------+-----------------------------------------------------------------------------------------------+----------+
 type ReceiveResult = Int64
 
 -- | Convert an 'UpdateResult' to the corresponding 'ReceiveResult' value.
@@ -791,12 +793,13 @@ toReceiveResult ResultChainUpdateInvalidSignatures = 28
 toReceiveResult ResultEnergyExceeded = 29
 toReceiveResult ResultInsufficientFunds = 30
 toReceiveResult ResultDoubleSign = 31
+toReceiveResult ResultConsensusFailure = 32
 
 -- | Handle receipt of a block.
 --  The possible return codes are @ResultSuccess@, @ResultSerializationFail@,
 --  @ResultInvalid@, @ResultPendingBlock@, @ResultDuplicate@, @ResultStale@,
 --  @ResultConsensusShutDown@, @ResultEarlyBlock@, @ResultInvalidGenesisIndex@, and
---  @ResultDoubleSign@.
+--  @ResultDoubleSign@. Additionally @ResultConsensusFailure@ is returned if an exception occurs.
 --  'receiveBlock' may invoke the callbacks for new finalization messages.
 --  If the block was successfully verified i.e. baker signature, finalization proofs etc. then
 --  the continuation for executing the block will be written to the 'Ptr' provided.
@@ -827,25 +830,27 @@ receiveBlock bptr genIndex msg msgLen ptrPtrExecuteBlock = do
             poke ptrPtrExecuteBlock =<< newStablePtr eb
             return $ toReceiveResult receiveResult
 
--- | Execute a block that has been received and succesfully verified.
+-- | Execute a block that has been received and successfully verified.
 --  The 'MV.ExecuteBlock' continuation is obtained via first calling 'receiveBlock' which in return
 --  will construct a pointer to the continuation.
 --  The 'StablePtr' is freed here and so this function should only be called once for each 'MV.ExecuteBlock'.
 --  The possible return codes are @ResultSuccess@, @ResultSerializationFail@, @ResultInvalid@
 --  and @ResultConsensusShutDown@.
+--  Additionally @ResultConsensusFailure@ is returned if an exception occurs.
 executeBlock :: StablePtr ConsensusRunner -> StablePtr MV.ExecuteBlock -> IO ReceiveResult
 executeBlock ptrConsensus ptrCont = do
     (ConsensusRunner mvr) <- deRefStablePtr ptrConsensus
     executableBlock <- deRefStablePtr ptrCont
     freeStablePtr ptrCont
     mvLog mvr External LLTrace "Executing block."
-    res <- MV.runBlock executableBlock
+    res <- runMVR (MV.executeBlock executableBlock) mvr
     return $ toReceiveResult res
 
 -- | Handle receipt of a finalization message.
 --  The possible return codes are @ResultSuccess@, @ResultSerializationFail@, @ResultInvalid@,
 --  @ResultPendingFinalization@, @ResultDuplicate@, @ResultStale@, @ResultIncorrectFinalizationSession@,
 --  @ResultUnverifiable@, @ResultConsensusShutDown@, @ResultInvalidGenesisIndex@, and @ResultDoubleSign@.
+--  Additionally @ResultConsensusFailure@ is returned if an exception occurs.
 --  'receiveFinalization' may invoke the callbacks for new finalization messages.
 receiveFinalizationMessage ::
     StablePtr ConsensusRunner ->
@@ -863,6 +868,7 @@ receiveFinalizationMessage bptr genIndex msg msgLen = do
 --  The possible return codes are @ResultSuccess@, @ResultSerializationFail@, @ResultInvalid@,
 --  @ResultPendingBlock@, @ResultPendingFinalization@, @ResultDuplicate@, @ResultStale@,
 --  @ResultConsensusShutDown@ and @ResultInvalidGenesisIndex@.
+--  Additionally @ResultConsensusFailure@ is returned if an exception occurs.
 --  'receiveFinalizationRecord' may invoke the callbacks for new finalization messages.
 receiveFinalizationRecord ::
     StablePtr ConsensusRunner ->
@@ -885,7 +891,8 @@ receiveFinalizationRecord bptr genIndex msg msgLen = do
 --  @ResultCredentialDeploymentInvalidIP@, @ResultCredentialDeploymentInvalidAR@,
 --  @ResultCredentialDeploymentExpired@, @ResultChainUpdateInvalidSequenceNumber@,
 --  @ResultChainUpdateInvalidEffectiveTime@, @ResultChainUpdateInvalidSignatures@,
---  @ResultEnergyExceeded@
+--  @ResultEnergyExceeded@.
+--  Additionally @ResultConsensusFailure@ is returned if an exception occurs.
 receiveTransaction :: StablePtr ConsensusRunner -> CString -> Int64 -> Ptr Word8 -> IO ReceiveResult
 receiveTransaction bptr transactionData transactionLen outPtr = do
     (ConsensusRunner mvr) <- deRefStablePtr bptr
@@ -907,6 +914,7 @@ receiveTransaction bptr transactionData transactionLen outPtr = do
 --  * @ResultPendingBlock@ -- the sender has some data I am missing, and should be marked pending
 --  * @ResultSuccess@ -- I do not require additional data from the sender, so mark it as up-to-date
 --  * @ResultContinueCatchUp@ -- The sender should be marked pending if it is currently up-to-date (no change otherwise)
+--  * @ResultConsensusFailure@ -- an internal exception occurred
 receiveCatchUpStatus ::
     -- | Consensus pointer
     StablePtr ConsensusRunner ->
@@ -957,6 +965,7 @@ getCatchUpStatus cptr genIndexPtr resPtr = do
 
 -- | Import a file consisting of a set of blocks and finalization records for the purposes of
 --  out-of-band catch-up.
+--  @ResultConsensusFailure@ is returned if an exception occurs.
 importBlocks ::
     -- | Consensus runner
     StablePtr ConsensusRunner ->
diff --git a/concordium-consensus/src/Concordium/KonsensusV1/SkovMonad.hs b/concordium-consensus/src/Concordium/KonsensusV1/SkovMonad.hs
index 73c014461..753673091 100644
--- a/concordium-consensus/src/Concordium/KonsensusV1/SkovMonad.hs
+++ b/concordium-consensus/src/Concordium/KonsensusV1/SkovMonad.hs
@@ -111,7 +111,8 @@ newtype SkovV1T pv m a = SkovV1T
           MonadLogger,
           TimeMonad,
           MonadReader (SkovV1Context pv m),
-          MonadThrow
+          MonadThrow,
+          MonadCatch
         )
     deriving
         (BlockStateTypes, ContractStateOperations, ModuleQuery)
@@ -299,17 +300,17 @@ instance (Monad m) => MonadConsensusEvent (SkovV1T pv m) where
         handler <- view onFinalizeHandler
         handler fe bp
 
-instance (MonadIO m, MonadLogger m) => TimerMonad (SkovV1T pv m) where
+instance (MonadIO m, MonadLogger m, MonadCatch m) => TimerMonad (SkovV1T pv m) where
     type Timer (SkovV1T pv m) = ThreadTimer
     onTimeout timeout a = do
         ctx <- ask
         liftIO $
             makeThreadTimer timeout $ do
-                let handler (SomeException e) =
-                        _skovV1TUnliftIO ctx $
-                            logEvent Konsensus LLError $
-                                "Error in timer thread: " ++ show e
-                void (_skovV1TUnliftIO ctx a) `catchAll` handler
+                let handler ex@(SomeException e) = do
+                        logEvent Konsensus LLError $
+                            "Error in timer thread: " ++ displayException e
+                        throwM ex
+                _skovV1TUnliftIO ctx (void a `catch` handler)
     cancelTimer = liftIO . cancelThreadTimer
 
 instance
diff --git a/concordium-consensus/src/Concordium/MultiVersion.hs b/concordium-consensus/src/Concordium/MultiVersion.hs
index 3a3a2bf32..c6848be56 100644
--- a/concordium-consensus/src/Concordium/MultiVersion.hs
+++ b/concordium-consensus/src/Concordium/MultiVersion.hs
@@ -23,9 +23,9 @@
 module Concordium.MultiVersion where
 
 import Control.Concurrent
-import Control.Exception
+import Control.Exception hiding (handle)
 import Control.Monad
-import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow (throwM))
+import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow (throwM), handle)
 import Control.Monad.Reader
 import qualified Control.Monad.State.Strict as State
 import Data.ByteString (ByteString)
@@ -34,6 +34,7 @@ import Data.IORef
 import Data.Serialize
 import qualified Data.Text as Text
 import Data.Time
+import Data.Typeable
 import qualified Data.Vector as Vec
 import System.FilePath
 
@@ -500,6 +501,25 @@ data CatchUpStatusBufferState
     | -- | We should not send any more catch-up status messages.
       BufferShutdown
 
+-- | A representation of whether the global write lock has been poisoned due to an exception in
+--  a thread that held the lock.
+data GlobalStateStatus
+    = -- | The global state is in a consistent state.
+      GSOk
+    | -- | A thread has thrown an exception while processing the global state, indicating an
+      --  unrecoverable error.
+      GSError
+    deriving (Eq)
+
+-- | An exception indicating that the global state lock was poisoned by an error in another thread.
+--  This indicates that some invariants of the global state may have been violated, and is not
+--  recoverable.
+data GlobalLockPoisonError = GlobalLockPoisonError
+    deriving (Eq, Show, Typeable)
+
+instance Exception GlobalLockPoisonError where
+    displayException _ = "The global state lock was poisoned by an error in another thread."
+
 -- | The context for managing multi-version consensus.
 data MultiVersionRunner finconf = MultiVersionRunner
     { -- | Base configuration.
@@ -515,7 +535,7 @@ data MultiVersionRunner finconf = MultiVersionRunner
       --  the write lock is held.
       mvVersions :: !(IORef (Vec.Vector (EVersionedConfiguration finconf))),
       -- | Global write lock.
-      mvWriteLock :: !(MVar ()),
+      mvWriteLock :: !(MVar GlobalStateStatus),
       -- | Flag to stop importing blocks. When importing blocks from a file is in progress,
       --  setting this flag to True will cause the import to stop.
       mvShouldStopImportingBlocks :: !(IORef Bool),
@@ -546,6 +566,25 @@ instance MonadLogger (MVR finconf) where
     logEvent src lvl msg = MVR $ \mvr -> mvLog mvr src lvl msg
     {-# INLINE logEvent #-}
 
+-- | Catch and log exceptions in the 'MVR' monad.
+--  Returns a specified value in the event of an exception.
+handleMVRExceptionsWith ::
+    -- | Value to return in the event of an exception.
+    a ->
+    -- | Action to run
+    MVR finconf a ->
+    MVR finconf a
+handleMVRExceptionsWith failRes = handle handler
+  where
+    handler (e :: SomeException) = do
+        logEvent Runner LLError $ "Unrecoverable exception: " <> displayException e
+        return failRes
+
+-- | Catch and log exceptions in the 'MVR' monad.
+--  Returns 'Skov.ResultConsensusFailure' in the event of an exception.
+handleMVRExceptions :: MVR finconf Skov.UpdateResult -> MVR finconf Skov.UpdateResult
+handleMVRExceptions = handleMVRExceptionsWith Skov.ResultConsensusFailure
+
 -- | Perform an action while holding the global state write lock.
 --  If the action throws an exception, this ensures that the lock is
 --  released.
@@ -561,14 +600,23 @@ withWriteLockIO :: MultiVersionRunner finconf -> IO a -> IO a
 withWriteLockIO MultiVersionRunner{..} a =
     bracketOnError
         (takeMVar mvWriteLock)
-        ( \() ->
-            tryPutMVar mvWriteLock ()
-                >> mvLog Runner LLWarning "Released global state lock following error."
+        ( \_ -> do
+            poisoned <- tryPutMVar mvWriteLock GSError
+            when poisoned $
+                mvLog
+                    Runner
+                    LLWarning
+                    "An error occurred while holding the global state lock.\
+                    \ This will be propagated to other threads."
         )
-        $ \_ -> do
-            res <- a
-            putMVar mvWriteLock ()
-            return res
+        $ \case
+            GSOk -> do
+                res <- a
+                putMVar mvWriteLock GSOk
+                return res
+            GSError -> do
+                putMVar mvWriteLock GSError
+                throwIO GlobalLockPoisonError
 
 -- | Perform an action while holding the global state write lock. Optionally, when the action
 --  completes, a thread is forked to perform a follow-up action before releasing the lock.
@@ -585,17 +633,26 @@ withWriteLockMaybeFork action followup = MVR $ \mvr ->
 withWriteLockMaybeForkIO :: MultiVersionRunner finconf -> IO (a, Maybe b) -> (b -> IO ()) -> IO a
 {-# INLINE withWriteLockMaybeForkIO #-}
 withWriteLockMaybeForkIO MultiVersionRunner{..} action followup = mask $ \unmask -> do
-    () <- takeMVar mvWriteLock
-    (res, mContinue) <- unmask action `onException` tryPutMVar mvWriteLock ()
+    gsStatus <- takeMVar mvWriteLock
+    when (gsStatus == GSError) $ do
+        putMVar mvWriteLock GSError
+        throwIO GlobalLockPoisonError
+    (res, mContinue) <- unmask action `onException` tryPutMVar mvWriteLock GSError
     case mContinue of
         Just continueArg -> do
-            let release = putMVar mvWriteLock ()
+            let release (Left exception) = do
+                    mvLog Runner LLError $
+                        "An unrecovarable error occurred in a worker thread\
+                        \ while holding the global state lock: "
+                            ++ show exception
+                    putMVar mvWriteLock GSError
+                release (Right _) = putMVar mvWriteLock GSOk
             -- forkIO is guaranteed to be uninterruptible, so we can be sure that an async exception
             -- won't prevent the lock being released. Also note that the masking state of the thread
             -- is inherited, so we unmask when running the follow-up.
-            void $ forkIO (unmask (try @SomeException (followup continueArg)) >> release)
+            void $ forkIO (unmask (try @SomeException (followup continueArg)) >>= release)
         Nothing -> do
-            putMVar mvWriteLock ()
+            putMVar mvWriteLock GSOk
     return res
 
 -- | Lift a 'LogIO' action into the 'MVR' monad.
@@ -1137,7 +1194,7 @@ makeMultiVersionRunner
         mvTransactionPurgingThread <- newEmptyMVar
         let mvr = MultiVersionRunner{..}
         runMVR (startupSkov genesis) mvr
-        putMVar mvWriteLock ()
+        putMVar mvWriteLock GSOk
         startTransactionPurgingThread mvr
         return mvr
 
@@ -1467,12 +1524,14 @@ shutdownMultiVersionRunner MultiVersionRunner{..} = mask_ $ do
     -- Kill the transaction purging thread, if any.
     tryTakeMVar mvTransactionPurgingThread >>= mapM_ killThread
     -- Acquire the write lock. This prevents further updates, as they will block.
-    takeMVar mvWriteLock
-    versions <- readIORef mvVersions
-    -- Shut down the consensus databases.
-    runLoggerT (forM_ versions evcShutdown) mvLog
-    -- Shut down the global account map.
-    LMDBAccountMap.closeDatabase (globalAccountMap (mvcStateConfig mvConfiguration))
+    takeMVar mvWriteLock >>= \case
+        GSOk -> do
+            versions <- readIORef mvVersions
+            -- Shut down the consensus databases.
+            runLoggerT (forM_ versions evcShutdown) mvLog
+            -- Shut down the global account map.
+            LMDBAccountMap.closeDatabase (globalAccountMap (mvcStateConfig mvConfiguration))
+        GSError -> throwIO GlobalLockPoisonError
 
 -- | Lift a version-0 consensus skov action to the 'MVR' monad, running it on a
 --  particular 'VersionedConfigurationV0'. Note that this does not
@@ -1678,58 +1737,67 @@ receiveBlock ::
     GenesisIndex ->
     ByteString ->
     MVR finconf (Skov.UpdateResult, Maybe ExecuteBlock)
-receiveBlock gi blockBS = withLatestExpectedVersion gi $ \case
-    (EVersionedConfigurationV0 (vc :: VersionedConfigurationV0 finconf pv)) -> do
-        MVR $ \mvr -> do
-            now <- currentTime
-            case deserializeExactVersionedPendingBlock (protocolVersion @pv) blockBS now of
-                Left err -> do
-                    mvLog mvr Runner LLDebug err
-                    return (Skov.ResultSerializationFail, Nothing)
-                Right block -> do
-                    (updateResult, mVerifiedPendingBlock) <- runMVR (runSkovV0Transaction vc (Skov.receiveBlock block)) mvr
-                    case mVerifiedPendingBlock of
-                        Nothing -> return (updateResult, Nothing)
-                        Just verifiedPendingBlock -> do
-                            let exec = do
-                                    runSkovV0Transaction vc (Skov.executeBlock verifiedPendingBlock)
-                            let cont = ExecuteBlock $ runMVR exec mvr
-                            return (updateResult, Just cont)
-    (EVersionedConfigurationV1 (vc :: VersionedConfigurationV1 finconf pv)) -> do
-        MVR $ \mvr -> do
-            now <- currentTime
-            case SkovV1.deserializeExactVersionedPendingBlock @pv blockBS now of
-                Left err -> do
-                    mvLog mvr Runner LLDebug err
-                    return (Skov.ResultSerializationFail, Nothing)
-                Right block -> do
-                    blockResult <- runMVR (runSkovV1Transaction vc (SkovV1.uponReceivingBlock block)) mvr
-                    case blockResult of
-                        SkovV1.BlockResultSuccess vb -> do
-                            let exec = do
-                                    runSkovV1Transaction vc (SkovV1.executeBlock vb)
-                                    return Skov.ResultSuccess
-                            let cont = ExecuteBlock $ runMVR exec mvr
-                            return (Skov.ResultSuccess, Just cont)
-                        SkovV1.BlockResultDoubleSign vb -> do
-                            runMVR (runSkovV1Transaction vc (SkovV1.executeBlock vb)) mvr
-                            return (Skov.ResultDoubleSign, Nothing)
-                        SkovV1.BlockResultInvalid -> return (Skov.ResultInvalid, Nothing)
-                        SkovV1.BlockResultStale -> return (Skov.ResultStale, Nothing)
-                        SkovV1.BlockResultPending -> return (Skov.ResultPendingBlock, Nothing)
-                        SkovV1.BlockResultEarly -> return (Skov.ResultEarlyBlock, Nothing)
-                        SkovV1.BlockResultDuplicate -> return (Skov.ResultDuplicate, Nothing)
-                        SkovV1.BlockResultConsensusShutdown -> return (Skov.ResultConsensusShutDown, Nothing)
+receiveBlock gi blockBS = handleMVRExceptionsWith (Skov.ResultConsensusFailure, Nothing) $
+    withLatestExpectedVersion gi $ \case
+        (EVersionedConfigurationV0 (vc :: VersionedConfigurationV0 finconf pv)) -> do
+            MVR $ \mvr -> do
+                now <- currentTime
+                case deserializeExactVersionedPendingBlock (protocolVersion @pv) blockBS now of
+                    Left err -> do
+                        mvLog mvr Runner LLDebug err
+                        return (Skov.ResultSerializationFail, Nothing)
+                    Right block -> do
+                        (updateResult, mVerifiedPendingBlock) <-
+                            runMVR
+                                (runSkovV0Transaction vc (Skov.receiveBlock block))
+                                mvr
+                        case mVerifiedPendingBlock of
+                            Nothing -> return (updateResult, Nothing)
+                            Just verifiedPendingBlock -> do
+                                let exec = do
+                                        runSkovV0Transaction vc $
+                                            Skov.executeBlock verifiedPendingBlock
+                                let cont = ExecuteBlock $ runMVR exec mvr
+                                return (updateResult, Just cont)
+        (EVersionedConfigurationV1 (vc :: VersionedConfigurationV1 finconf pv)) -> do
+            MVR $ \mvr -> do
+                now <- currentTime
+                case SkovV1.deserializeExactVersionedPendingBlock @pv blockBS now of
+                    Left err -> do
+                        mvLog mvr Runner LLDebug err
+                        return (Skov.ResultSerializationFail, Nothing)
+                    Right block -> do
+                        blockResult <-
+                            runMVR
+                                (runSkovV1Transaction vc (SkovV1.uponReceivingBlock block))
+                                mvr
+                        case blockResult of
+                            SkovV1.BlockResultSuccess vb -> do
+                                let exec = do
+                                        runSkovV1Transaction vc (SkovV1.executeBlock vb)
+                                        return Skov.ResultSuccess
+                                let cont = ExecuteBlock $ runMVR exec mvr
+                                return (Skov.ResultSuccess, Just cont)
+                            SkovV1.BlockResultDoubleSign vb -> do
+                                runMVR (runSkovV1Transaction vc (SkovV1.executeBlock vb)) mvr
+                                return (Skov.ResultDoubleSign, Nothing)
+                            SkovV1.BlockResultInvalid -> return (Skov.ResultInvalid, Nothing)
+                            SkovV1.BlockResultStale -> return (Skov.ResultStale, Nothing)
+                            SkovV1.BlockResultPending -> return (Skov.ResultPendingBlock, Nothing)
+                            SkovV1.BlockResultEarly -> return (Skov.ResultEarlyBlock, Nothing)
+                            SkovV1.BlockResultDuplicate -> return (Skov.ResultDuplicate, Nothing)
+                            SkovV1.BlockResultConsensusShutdown ->
+                                return (Skov.ResultConsensusShutDown, Nothing)
 
 -- | Invoke the continuation yielded by 'receiveBlock'.
 --  The continuation performs a transaction which will acquire the write lock
 --  before trying to add the block to the tree and release the lock again afterwards.
 executeBlock :: ExecuteBlock -> MVR finconf Skov.UpdateResult
-executeBlock = liftIO . runBlock
+executeBlock = handleMVRExceptions . liftIO . runBlock
 
 -- | Deserialize and receive a finalization message at a given genesis index.
 receiveFinalizationMessage :: GenesisIndex -> ByteString -> MVR finconf Skov.UpdateResult
-receiveFinalizationMessage gi finMsgBS = withLatestExpectedVersion_ gi $ \case
+receiveFinalizationMessage gi finMsgBS = handleMVRExceptions $ withLatestExpectedVersion_ gi $ \case
     (EVersionedConfigurationV0 (vc :: VersionedConfigurationV0 finconf pv)) ->
         case runGet getExactVersionedFPM finMsgBS of
             Left err -> do
@@ -1748,16 +1816,16 @@ receiveFinalizationMessage gi finMsgBS = withLatestExpectedVersion_ gi $ \case
                             Left leftRes -> (leftRes, Nothing)
                             Right cont -> (Skov.ResultSuccess, Just cont)
                     followup = liftSkovV1Update vc
-                -- We spawn a thread to perform the follow-up so that the P2P layer can immediately
-                -- relay the message, since the follow-up action can be time consuming (including
-                -- finalizing blocks and baking a new block).
+                -- We spawn a thread to perform the follow-up so that the P2P layer can
+                -- immediately relay the message, since the follow-up action can be time
+                -- consuming (including finalizing blocks and baking a new block).
                 withWriteLockMaybeFork receive followup
 
 -- | Deserialize and receive a finalization entity.
 --  For consensus version 0 this should be a 'FinalizationRecord'.
 --  For consensus version 1 this should be a 'FinalizationEntry'.
 receiveFinalization :: GenesisIndex -> ByteString -> MVR finconf Skov.UpdateResult
-receiveFinalization gi finBS = withLatestExpectedVersion_ gi $ \case
+receiveFinalization gi finBS = handleMVRExceptions $ withLatestExpectedVersion_ gi $ \case
     (EVersionedConfigurationV0 (vc :: VersionedConfigurationV0 finconf pv)) ->
         case runGet getExactVersionedFinalizationRecord finBS of
             Left err -> do
@@ -1794,7 +1862,7 @@ receiveCatchUpStatus ::
     CatchUpConfiguration ->
     MVR finconf Skov.UpdateResult
 receiveCatchUpStatus gi catchUpBS cuConfig@CatchUpConfiguration{..} =
-    case runGet getVersionedCatchUpStatus catchUpBS of
+    handleMVRExceptions $ case runGet getVersionedCatchUpStatus catchUpBS of
         Left err -> do
             logEvent Runner LLDebug $ "Could not deserialize catch-up status message: " ++ err
             return Skov.ResultSerializationFail
@@ -1988,7 +2056,7 @@ getCatchUpRequest = do
 --  the result of the update. The hash is present unless the transaction could
 --  not be deserialized.
 receiveTransaction :: forall finconf. ByteString -> MVR finconf (Maybe TransactionHash, Skov.UpdateResult)
-receiveTransaction transactionBS = do
+receiveTransaction transactionBS = handleMVRExceptionsWith (Nothing, Skov.ResultConsensusFailure) $ do
     now <- utcTimeToTransactionTime <$> currentTime
     mvr <- ask
     vvec <- liftIO $ readIORef $ mvVersions mvr
@@ -2094,7 +2162,7 @@ receiveExecuteBlock gi blockBS = withLatestExpectedVersion_ gi $ \case
 
 -- | Import a block file for out-of-band catch-up.
 importBlocks :: FilePath -> MVR finconf Skov.UpdateResult
-importBlocks importFile = do
+importBlocks importFile = handleMVRExceptions $ do
     vvec <- liftIO . readIORef =<< asks mvVersions
     -- Import starting from the genesis index of the latest consensus
     let genIndex = evcIndex (Vec.last vvec)
diff --git a/concordium-consensus/src/Concordium/Skov/Monad.hs b/concordium-consensus/src/Concordium/Skov/Monad.hs
index 39d2724c9..d479d1be5 100644
--- a/concordium-consensus/src/Concordium/Skov/Monad.hs
+++ b/concordium-consensus/src/Concordium/Skov/Monad.hs
@@ -111,6 +111,8 @@ data UpdateResult
       ResultInsufficientFunds
     | -- | The consensus message is a result of double signing, indicating malicious behaviour.
       ResultDoubleSign
+    | -- | The consensus has thrown an exception and entered an unrecoverable state.
+      ResultConsensusFailure
     deriving (Eq, Show)
 
 -- | Maps a 'TV.VerificationResult' to the corresponding 'UpdateResult' type.
diff --git a/concordium-node/Cargo.lock b/concordium-node/Cargo.lock
index 40eae7505..3e0e55898 100644
--- a/concordium-node/Cargo.lock
+++ b/concordium-node/Cargo.lock
@@ -787,7 +787,7 @@ dependencies = [
 
 [[package]]
 name = "concordium_node"
-version = "7.0.0"
+version = "7.0.1"
 dependencies = [
  "anyhow",
  "app_dirs2",
diff --git a/concordium-node/src/consensus_ffi/ffi.rs b/concordium-node/src/consensus_ffi/ffi.rs
index e6ee2494b..1faddf7de 100644
--- a/concordium-node/src/consensus_ffi/ffi.rs
+++ b/concordium-node/src/consensus_ffi/ffi.rs
@@ -1958,7 +1958,8 @@ impl ConsensusContainer {
 
         (
             ConsensusFfiResponse::try_from(result)
-                .unwrap_or_else(|code| panic!("Unknown FFI return code: {}", code)),
+                .unwrap_or_else(|code| panic!("Unknown FFI return code: {}", code))
+                .check_consistent(),
             callback,
         )
     }
@@ -1971,14 +1972,17 @@ impl ConsensusContainer {
         let result = unsafe { executeBlock(consensus, execute_block_callback) };
         ConsensusFfiResponse::try_from(result)
             .unwrap_or_else(|code| panic!("Unknown FFI return code: {}", code))
+            .check_consistent()
     }
 
     pub fn send_finalization(&self, genesis_index: u32, msg: &[u8]) -> ConsensusFfiResponse {
         wrap_send_data_to_c!(self, genesis_index, msg, receiveFinalizationMessage)
+        .check_consistent()
     }
 
     pub fn send_finalization_record(&self, genesis_index: u32, rec: &[u8]) -> ConsensusFfiResponse {
         wrap_send_data_to_c!(self, genesis_index, rec, receiveFinalizationRecord)
+        .check_consistent()
     }
 
     /// Send a transaction to consensus. Return whether the operation succeeded
@@ -1993,7 +1997,8 @@ impl ConsensusContainer {
         };
 
         let return_code = ConsensusFfiResponse::try_from(result)
-            .unwrap_or_else(|code| panic!("Unknown FFI return code: {}", code));
+            .unwrap_or_else(|code| panic!("Unknown FFI return code: {}", code))
+            .check_consistent();
         if return_code == ConsensusFfiResponse::Success {
             (Some(out_hash.into()), return_code)
         } else {
@@ -2054,6 +2059,7 @@ impl ConsensusContainer {
 
         ConsensusFfiResponse::try_from(result)
             .unwrap_or_else(|code| panic!("Unknown FFI return code: {}", code))
+            .check_consistent()
     }
 
     /// Gets baker status of the node along with the baker ID
@@ -2105,7 +2111,7 @@ impl ConsensusContainer {
         let len = path_bytes.len();
 
         let response = unsafe { importBlocks(consensus, path_bytes.as_ptr(), len as i64) };
-        match ConsensusFfiResponse::try_from(response)? {
+        match ConsensusFfiResponse::try_from(response)?.check_consistent() {
             ConsensusFfiResponse::Success => Ok(()),
             other => bail!("Error during block import: {}", other),
         }
diff --git a/concordium-node/src/consensus_ffi/helpers.rs b/concordium-node/src/consensus_ffi/helpers.rs
index 808cffdd0..ea2ba290b 100644
--- a/concordium-node/src/consensus_ffi/helpers.rs
+++ b/concordium-node/src/consensus_ffi/helpers.rs
@@ -190,6 +190,8 @@ pub enum ConsensusFfiResponse {
     InsufficientFunds,
     #[error("The consensus message is a result of double signing")]
     DoubleSign,
+    #[error("Consensus entered an unrecoverable state")]
+    ConsensusFailure,
 }
 
 impl ConsensusFfiResponse {
@@ -259,7 +261,8 @@ impl ConsensusFfiResponse {
             | BakerNotFound
             | MissingImportFile
             | ContinueCatchUp
-            | DoubleSign => false,
+            | DoubleSign
+            | ConsensusFailure => false,
             PendingBlock => packet_type != PacketType::Block,
             Success | PendingFinalization | Asynchronous => true,
         }
@@ -276,6 +279,14 @@ impl ConsensusFfiResponse {
             "invalid"
         }
     }
+
+    /// Panic if the response indicates an unrecoverable consensus failure.
+    pub fn check_consistent(self) -> Self {
+        if let ConsensusFfiResponse::ConsensusFailure = self {
+            panic!("Consensus entered an unrecoverable state.");
+        }
+        self
+    }
 }
 
 #[derive(Debug, Error)]
@@ -331,6 +342,7 @@ impl TryFrom<i64> for ConsensusFfiResponse {
             29 => Ok(MaxBlockEnergyExceeded),
             30 => Ok(InsufficientFunds),
             31 => Ok(DoubleSign),
+            32 => Ok(ConsensusFailure),
             _ => Err(ConsensusFfiResponseConversionError {
                 unknown_code: value,
             }),

From 747a3c69224bb6d7d3e8ff69c83541c4077bbb2a Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Wed, 11 Sep 2024 11:17:17 +0200
Subject: [PATCH 70/81] Update changelog.

---
 CHANGELOG.md | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 0375af7f2..e4d64172a 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -2,6 +2,8 @@
 
 ## Unreleased changes
 
+- Improve consensus behaviour in the event of an unrecoverable exception.
+
 ## 7.0.1
 
 - Fix a bug in migration from protocol version 6 to 7.

From e04ea03b8988f88249e1e364166538d0ee57d0f5 Mon Sep 17 00:00:00 2001
From: Emil B <eb@concordium.com>
Date: Wed, 11 Sep 2024 12:43:53 +0200
Subject: [PATCH 71/81] Address review comments.

---
 .../GlobalState/Persistent/BlockState.hs      | 34 +++++++++++--------
 1 file changed, 20 insertions(+), 14 deletions(-)

diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
index b04248360..07a3a127f 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
@@ -1612,6 +1612,7 @@ newAddValidator pbs ai va@ValidatorAdd{..} = do
                 }
     let bakerInfo = bakerKeyUpdateToInfo bid vaKeys
     let bakerInfoEx = BaseAccounts.BakerInfoExV1 bakerInfo poolInfo
+    -- The precondition guaranties that the account exists
     acc <- fromJust <$> Accounts.indexedAccount ai (bspAccounts bsp)
     -- Add the baker to the account.
     accWithBaker <- addAccountBakerV1 bakerInfoEx vaCapital vaRestakeEarnings acc
@@ -1751,7 +1752,7 @@ updateValidatorChecks bsp baker ValidatorUpdate{..} = do
 --
 --        (3) append @BakerConfigureBakingRewardCommission brc@ to @events@.
 --
---  6. If the finalization reward commission is supplied:
+--  7. If the finalization reward commission is supplied:
 --
 --        (1) if the commission does not fall within the current range according to the chain
 --            parameters, return @VCFFinalizationRewardCommissionNotInRange@; otherwise,
@@ -1760,7 +1761,7 @@ updateValidatorChecks bsp baker ValidatorUpdate{..} = do
 --
 --        (3) append @BakerConfigureFinalizationRewardCommission frc@ to @events@.
 --
---  7. If the capital is supplied: if there is a pending change to the baker's capital, return
+--  8. If the capital is supplied: if there is a pending change to the baker's capital, return
 --     @VCFChangePending@; otherwise:
 --
 --       * if the capital is 0
@@ -1797,7 +1798,7 @@ updateValidatorChecks bsp baker ValidatorUpdate{..} = do
 --         index by adding the difference between the new and old capital) and append
 --         @BakerConfigureStakeIncreased capital@ to @events@.
 --
---  8. Return @events@ with the updated block state.
+--  9. Return @events@ with the updated block state.
 newUpdateValidator ::
     forall pv m.
     ( SupportsPersistentState pv m,
@@ -1814,7 +1815,7 @@ newUpdateValidator ::
     MTL.ExceptT ValidatorConfigureFailure m ([BakerConfigureUpdateChange], PersistentBlockState (MPV m))
 newUpdateValidator pbs curTimestamp ai vu@ValidatorUpdate{..} = do
     bsp <- loadPBS pbs
-    -- Cannot fail: account must exist.
+    -- Cannot fail: The precondition guaranties that the account exists
     acc <- fromJust <$> Accounts.indexedAccount ai (bspAccounts bsp)
     -- Cannot fail: account must be a registered baker.
     existingBaker <- fromJust <$> accountBaker acc
@@ -1830,6 +1831,7 @@ newUpdateValidator pbs curTimestamp ai vu@ValidatorUpdate{..} = do
     (events,) <$> storePBS pbs newBSP
   where
     bid = BakerId ai
+    -- Only do the given update if specified.
     ifPresent Nothing _ = return
     ifPresent (Just v) k = k v
     updateKeys oldBaker = ifPresent vuKeys $ \keys (bsp, acc) -> do
@@ -2125,7 +2127,7 @@ newAddDelegator pbs ai da@DelegatorAdd{..} = do
     addDelegatorChecks bsp da
     newBirkParameters <- do
         pab <- refLoad $ bspBirkParameters bsp ^. birkActiveBakers
-        -- Cannot fail: the delegation target is valid.
+        -- Cannot fail: the delegation target is valid because it is checked in 'addDelegatorChecks'.
         newActiveBakers <-
             addDelegatorUnsafe daDelegationTarget did daCapital pab
                 <&> totalActiveCapital %~ addActiveCapital daCapital
@@ -2210,7 +2212,7 @@ updateDelegatorChecks bsp oldDelegator DelegatorUpdate{..} = do
         Nothing -> case oldDelegator ^. BaseAccounts.delegationTarget of
             Transactions.DelegatePassive -> return Nothing
             Transactions.DelegateToBaker (BakerId baid) -> do
-                -- Cannot fail: the account must delegate to a valid baker.
+                -- Cannot fail: the account is already delegating to a baker that can thus be looked up.
                 baker <- fromJust <$> onAccount baid bsp accountBaker
                 -- Since it wasn't changed, the baker is the same as before.
                 return (Just (baker, True))
@@ -2291,7 +2293,7 @@ updateDelegatorChecks bsp oldDelegator DelegatorUpdate{..} = do
 --
 --       (4) Update the account to record the new delegation target.
 --
---       (5) Append @DelegationConfigureDelegationTarget target@ to @events@. [N.B. if the target is
+--       (5) Append @DelegationConfigureDelegationTarget target@ to @events@. [N.B. if the target
 --           pool is the same as the previous value, steps (1)-(4) will do nothing and may be skipped
 --           by the implementation. This relies on the invariant that delegators delegate only to
 --           valid pools.]
@@ -2309,7 +2311,7 @@ updateDelegatorChecks bsp oldDelegator DelegatorUpdate{..} = do
 --         plus the delegator cooldown chain parameter, and append
 --         @DelegationConfigureStakeReduced capital@ to @events@; otherwise
 --
---       * If the the new capital is less than the current staked capital (but not 0), mark the
+--       * If the new capital is less than the current staked capital (but not 0), mark the
 --         delegator as pending stake reduction to @capital@ at the slot timestamp plus the
 --         delegator cooldown chain parameter, and append @DelegationConfigureStakeReduced capital@
 --         to @events@;
@@ -2352,7 +2354,7 @@ newUpdateDelegator ::
     MTL.ExceptT DelegatorConfigureFailure m ([DelegationConfigureUpdateChange], PersistentBlockState (MPV m))
 newUpdateDelegator pbs blockTimestamp ai du@DelegatorUpdate{..} = do
     bsp <- loadPBS pbs
-    -- Cannot fail: account must exist.
+    -- Cannot fail: The precondition guarantees that the account exists.
     acc <- fromJust <$> Accounts.indexedAccount ai (bspAccounts bsp)
     -- Cannot fail: the account must already be a delegator.
     existingDelegator <- fromJust <$> accountDelegator acc
@@ -2480,17 +2482,21 @@ newUpdateDelegator pbs blockTimestamp ai du@DelegatorUpdate{..} = do
                 (bspAccountsInCooldown bsp)
         return bsp{bspAccountsInCooldown = newAccountsInCooldown}
 
+-- | Whether a (pre-)(pre-)cooldown was removed on an account. Used by 'applyCooldownRemovalsGlobally'
+-- to then also remove the account from the global list of accounts in cooldown.
 data CooldownRemovals = CooldownRemovals
     { -- | Whether the pre-pre cooldown was removed.
-      crPrePreCooldown :: Bool,
+      crPrePreCooldown :: !Bool,
       -- | Whether the pre cooldown was removed.
-      crPreCooldown :: Bool,
+      crPreCooldown :: !Bool,
       -- | If all cooldowns were removed, this is the previous timestamp of the earliest cooldown.
-      crCooldown :: Maybe Timestamp
+      crCooldown :: !(Maybe Timestamp)
     }
 
 -- | Determine if a change in cooldowns requires global updates to the indexes.
 --  The change should arise from (possibly) reactivating stake from cooldown.
+--  The first input is old 'Cooldowns' on the account, and the second input is the new 'Cooldowns' on
+--  the account after possibly reactivating stake.
 cooldownRemovals ::
     Maybe CooldownQueue.Cooldowns -> Maybe CooldownQueue.Cooldowns -> CooldownRemovals
 cooldownRemovals Nothing _ = CooldownRemovals False False Nothing
@@ -2793,8 +2799,8 @@ doMint pbs mint = do
             bspBank bsp
                 & unhashed
                     %~ (Rewards.totalGTU +~ mintTotal mint)
-                        . (Rewards.bakingRewardAccount +~ mintBakingReward mint)
-                        . (Rewards.finalizationRewardAccount +~ mintFinalizationReward mint)
+                    . (Rewards.bakingRewardAccount +~ mintBakingReward mint)
+                    . (Rewards.finalizationRewardAccount +~ mintFinalizationReward mint)
     let updAcc = addAccountAmount $ mintDevelopmentCharge mint
     foundationAccount <- (^. cpFoundationAccount) <$> lookupCurrentParameters (bspUpdates bsp)
     newAccounts <- Accounts.updateAccountsAtIndex' updAcc foundationAccount (bspAccounts bsp)

From 24f1f9931a538a1eaa2a63ef73a9754dd1e21552 Mon Sep 17 00:00:00 2001
From: Emil B <eb@concordium.com>
Date: Wed, 11 Sep 2024 12:47:52 +0200
Subject: [PATCH 72/81] Address one more review comment.

---
 .../src/Concordium/GlobalState/Persistent/BlockState.hs          | 1 +
 1 file changed, 1 insertion(+)

diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
index 07a3a127f..d9fbf3d0a 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
@@ -2371,6 +2371,7 @@ newUpdateDelegator pbs blockTimestamp ai du@DelegatorUpdate{..} = do
   where
     did = DelegatorId ai
     flexibleCooldown = sSupportsFlexibleCooldown (accountVersion @(AccountVersionFor pv))
+    -- Only do the update if specified.
     ifPresent Nothing _ = return
     ifPresent (Just v) k = k v
     updateDelegationTarget oldTarget = ifPresent duDelegationTarget $ \target (bsp, acc) -> do

From b66f7411156ec52ed42c11b52f24e500c3699667 Mon Sep 17 00:00:00 2001
From: Emil B <eb@concordium.com>
Date: Wed, 11 Sep 2024 13:11:54 +0200
Subject: [PATCH 73/81] Address comments from code review.

---
 .../scheduler/SchedulerTests/Delegation.hs    | 92 +++++++++----------
 1 file changed, 46 insertions(+), 46 deletions(-)

diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/Delegation.hs b/concordium-consensus/tests/scheduler/SchedulerTests/Delegation.hs
index e40da0dff..9f2d88b22 100644
--- a/concordium-consensus/tests/scheduler/SchedulerTests/Delegation.hs
+++ b/concordium-consensus/tests/scheduler/SchedulerTests/Delegation.hs
@@ -215,13 +215,13 @@ initialBlockState2 =
         ]
 
 -- | Test removing a delegator even if the stake is over the threshold.
-testCase1 ::
+testRemoveDelegatorWithStakeOverThreshold ::
     forall pv.
     (IsProtocolVersion pv, PVSupportsDelegation pv) =>
     SProtocolVersion pv ->
     String ->
     Spec
-testCase1 _ pvString =
+testRemoveDelegatorWithStakeOverThreshold _ pvString =
     specify (pvString ++ ": Remove delegation") $ do
         let transactions =
                 [ Runner.TJSON
@@ -261,13 +261,13 @@ testCase1 _ pvString =
         Helpers.assertBlockStateInvariantsH blockState (Helpers.srExecutionCosts result)
 
 -- | Test reducing delegator stake in such a way that it stays above the cap threshold.
-testCase2 ::
+testReduceDelegatorStakeStillAboveCapThreshold ::
     forall pv.
     (IsProtocolVersion pv, PVSupportsDelegation pv) =>
     SProtocolVersion pv ->
     String ->
     Spec
-testCase2 _ pvString =
+testReduceDelegatorStakeStillAboveCapThreshold _ pvString =
     specify (pvString ++ ": Reduce delegation stake with overstaking") $ do
         let transactions =
                 [ Runner.TJSON
@@ -298,13 +298,13 @@ testCase2 _ pvString =
         Helpers.assertBlockStateInvariantsH blockState (Helpers.srExecutionCosts result)
 
 -- | Test transaction rejects if increasing stake above the threshold of the pool
-testCase3 ::
+testTransactionRejectsIfStakeIncreasedOverThreshold ::
     forall pv.
     (IsProtocolVersion pv, PVSupportsDelegation pv) =>
     SProtocolVersion pv ->
     String ->
     Spec
-testCase3 _ pvString =
+testTransactionRejectsIfStakeIncreasedOverThreshold _ pvString =
     specify (pvString ++ ": Increase stake with overstaking") $ do
         let transactions =
                 [ Runner.TJSON
@@ -336,13 +336,13 @@ testCase3 _ pvString =
 
 -- | Test reducing delegator stake **and changing target** such that the new stake is above the cap
 --  for the new target.
-testCase4 ::
+testReducingStakeAndTargetNewStakeOverCap ::
     forall pv.
     (IsProtocolVersion pv, PVSupportsDelegation pv) =>
     SProtocolVersion pv ->
     String ->
     Spec
-testCase4 _ pvString =
+testReducingStakeAndTargetNewStakeOverCap _ pvString =
     specify (pvString ++ ": Reduce stake and change target 1") $ do
         let transactions =
                 [ Runner.TJSON
@@ -376,13 +376,13 @@ testCase4 _ pvString =
 --  This still fails before P7 because the change of stake is only effective after the cooldown period,
 --  so changing the target results in overdelegation to the new target. From P7, the stake is
 --  reduced immediately, so the transaction should succeed.
-testCase5 ::
+testChangingTargetAndReducingStake ::
     forall pv.
     (IsProtocolVersion pv, PVSupportsDelegation pv) =>
     SProtocolVersion pv ->
     String ->
     Spec
-testCase5 _ pvString =
+testChangingTargetAndReducingStake _ pvString =
     specify (pvString ++ ": Reduce stake and change target 2") $ do
         let transactions =
                 [ Runner.TJSON
@@ -421,13 +421,13 @@ testCase5 _ pvString =
         Helpers.assertBlockStateInvariantsH blockState (Helpers.srExecutionCosts result)
 
 -- | Increase stake successfully.
-testCase6 ::
+testIncreaseStake ::
     forall pv.
     (IsProtocolVersion pv, PVSupportsDelegation pv) =>
     SProtocolVersion pv ->
     String ->
     Spec
-testCase6 _ pvString =
+testIncreaseStake _ pvString =
     specify (pvString ++ ": Increase stake successfully.") $ do
         let transactions =
                 [ Runner.TJSON
@@ -458,13 +458,13 @@ testCase6 _ pvString =
         Helpers.assertBlockStateInvariantsH blockState (Helpers.srExecutionCosts result)
 
 -- | Increase stake and change target successfully.
-testCase7 ::
+testIncreaseStakeAndTarget ::
     forall pv.
     (IsProtocolVersion pv, PVSupportsDelegation pv) =>
     SProtocolVersion pv ->
     String ->
     Spec
-testCase7 _ pvString =
+testIncreaseStakeAndTarget _ pvString =
     specify (pvString ++ ": Increase stake and change target successfully.") $ do
         let transactions =
                 [ Runner.TJSON
@@ -499,13 +499,13 @@ testCase7 _ pvString =
         Helpers.assertBlockStateInvariantsH blockState (Helpers.srExecutionCosts result)
 
 -- | Increase stake and change target rejects with reason: maximum threshold for pool.
-testCase8 ::
+testIncreaseStakeAndChangeTargetReject ::
     forall pv.
     (IsProtocolVersion pv, PVSupportsDelegation pv) =>
     SProtocolVersion pv ->
     String ->
     Spec
-testCase8 _ pvString =
+testIncreaseStakeAndChangeTargetReject _ pvString =
     specify (pvString ++ ": Increase stake and change target so that results is overdelegation.") $ do
         let transactions =
                 [ Runner.TJSON
@@ -535,14 +535,14 @@ testCase8 _ pvString =
     checkState result blockState =
         Helpers.assertBlockStateInvariantsH blockState (Helpers.srExecutionCosts result)
 
--- | Increase stake and change target rejects with reason: maximum threshold for pool.
-testCase9 ::
+-- | Change target to overdelegated pool
+testChangeTargetToOverdelegatedPool ::
     forall pv.
     (IsProtocolVersion pv, PVSupportsDelegation pv) =>
     SProtocolVersion pv ->
     String ->
     Spec
-testCase9 _ pvString =
+testChangeTargetToOverdelegatedPool _ pvString =
     specify (pvString ++ ": Change target to overdelegated pool.") $ do
         let transactions =
                 [ Runner.TJSON
@@ -573,13 +573,13 @@ testCase9 _ pvString =
         Helpers.assertBlockStateInvariantsH blockState (Helpers.srExecutionCosts result)
 
 -- | Add delegator successfully.
-testCase10 ::
+testAddDelegator ::
     forall pv.
     (IsProtocolVersion pv, PVSupportsDelegation pv) =>
     SProtocolVersion pv ->
     String ->
     Spec
-testCase10 _ pvString =
+testAddDelegator _ pvString =
     specify (pvString ++ ": Add delegator successfully.") $ do
         let transactions =
                 [ Runner.TJSON
@@ -616,13 +616,13 @@ testCase10 _ pvString =
         ]
 
 -- | Add delegator with 0 stake should get rejected.
-testCase10A ::
+testDelegatorWithZeroStake ::
     forall pv.
     (IsProtocolVersion pv, PVSupportsDelegation pv) =>
     SProtocolVersion pv ->
     String ->
     Spec
-testCase10A _ pvString =
+testDelegatorWithZeroStake _ pvString =
     specify (pvString ++ ": Add delegator with 0 stake should get rejected.") $ do
         let transactions =
                 [ Runner.TJSON
@@ -653,13 +653,13 @@ testCase10A _ pvString =
         Helpers.assertBlockStateInvariantsH blockState (Helpers.srExecutionCosts result)
 
 -- | Add delegator when already baker. Should get rejected in protocols <= P6 and accepted from P7.
-testCase11 ::
+testAddDelegatorWhenAlreadyBaker ::
     forall pv.
     (IsProtocolVersion pv, PVSupportsDelegation pv) =>
     SProtocolVersion pv ->
     String ->
     Spec
-testCase11 spv pvString =
+testAddDelegatorWhenAlreadyBaker spv pvString =
     specify (pvString ++ ": Add delegator when already baker.") $ do
         let transactions =
                 [ Runner.TJSON
@@ -702,13 +702,13 @@ testCase11 spv pvString =
 
 -- | Add delegator with 0 stake when already a baker should get rejected with
 --  `AlreadyABaker` in protocols <= P6 and `InsufficientDelegationStake` from P7.
-testCase11A ::
+testAddDelegatorWithZeroStakeWhenAlreadyBaker ::
     forall pv.
     (IsProtocolVersion pv, PVSupportsDelegation pv) =>
     SProtocolVersion pv ->
     String ->
     Spec
-testCase11A spv pvString =
+testAddDelegatorWithZeroStakeWhenAlreadyBaker spv pvString =
     specify (pvString ++ ": Add delegator with 0 stake when already baker should get rejected.") $ do
         let transactions =
                 [ Runner.TJSON
@@ -753,13 +753,13 @@ testCase11A spv pvString =
                 updatedBaker4
 
 -- | Reduce stake while in cooldown.
-testCase12 ::
+testReduceStakeWhileInCooldown ::
     forall pv.
     (IsProtocolVersion pv, PVSupportsDelegation pv) =>
     SProtocolVersion pv ->
     String ->
     Spec
-testCase12 spv pvString =
+testReduceStakeWhileInCooldown spv pvString =
     specify (pvString ++ ": Reduce stake while in cooldown.") $ do
         let transactionsAndAssertions :: [Helpers.TransactionAndAssertion pv]
             transactionsAndAssertions =
@@ -864,13 +864,13 @@ testCase12 spv pvString =
 
 -- | Change baker to delegate to itself should get rejected with
 --  `AlreadyABaker` in protocols <= P6 and `DelegationTargetNotABaker` from P7.
-testCase13 ::
+testDelegateToSelf ::
     forall pv.
     (IsProtocolVersion pv, PVSupportsDelegation pv) =>
     SProtocolVersion pv ->
     String ->
     Spec
-testCase13 spv pvString =
+testDelegateToSelf spv pvString =
     specify (pvString ++ ": Change baker to delegate to itself.") $ do
         let transactions =
                 [ Runner.TJSON
@@ -925,18 +925,18 @@ tests =
         case delegationSupport @(AccountVersionFor pv) of
             SAVDelegationNotSupported -> return ()
             SAVDelegationSupported -> do
-                testCase1 spv pvString
-                testCase2 spv pvString
-                testCase3 spv pvString
-                testCase4 spv pvString
-                testCase5 spv pvString
-                testCase6 spv pvString
-                testCase7 spv pvString
-                testCase8 spv pvString
-                testCase9 spv pvString
-                testCase10 spv pvString
-                testCase10A spv pvString
-                testCase11 spv pvString
-                testCase11A spv pvString
-                testCase12 spv pvString
-                testCase13 spv pvString
+                testRemoveDelegatorWithStakeOverThreshold spv pvString
+                testReduceDelegatorStakeStillAboveCapThreshold spv pvString
+                testTransactionRejectsIfStakeIncreasedOverThreshold spv pvString
+                testReducingStakeAndTargetNewStakeOverCap spv pvString
+                testChangingTargetAndReducingStake spv pvString
+                testIncreaseStake spv pvString
+                testIncreaseStakeAndTarget spv pvString
+                testIncreaseStakeAndChangeTargetReject spv pvString
+                testChangeTargetToOverdelegatedPool spv pvString
+                testAddDelegator spv pvString
+                testDelegatorWithZeroStake spv pvString
+                testAddDelegatorWhenAlreadyBaker spv pvString
+                testAddDelegatorWithZeroStakeWhenAlreadyBaker spv pvString
+                testReduceStakeWhileInCooldown spv pvString
+                testDelegateToSelf spv pvString

From 72d5f73e66ad8f0ed0b37078f18e4628d3b93fc1 Mon Sep 17 00:00:00 2001
From: Emil B <eb@concordium.com>
Date: Wed, 11 Sep 2024 13:30:04 +0200
Subject: [PATCH 74/81] Address more comments from code review.

---
 .../src/Concordium/GlobalState/Persistent/Accounts.hs        | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs
index 908fe9e75..198339807 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs
@@ -425,9 +425,12 @@ updateAccountsAtIndex fupd ai a0@Accounts{..} =
 --  (If the account does not exist, this will throw an error.)
 setAccountAtIndex :: (SupportsPersistentAccount pv m) => AccountIndex -> PersistentAccount (AccountVersionFor pv) -> Accounts pv -> m (Accounts pv)
 setAccountAtIndex ai newAcct a0@Accounts{..} =
-    L.update (const (return ((), newAcct))) ai accountTable >>= \case
+    L.update setUpdate ai accountTable >>= \case
         Nothing -> error $ "setAccountAtIndex: no account at index " ++ show ai
         Just (_, act') -> return (a0{accountTable = act'})
+  where
+    -- Replace the old account with the new account, returning ().
+    setUpdate _ = return ((), newAcct)
 
 -- | Perform an update to an account with the given index.
 --  Does nothing if the account does not exist.

From 0b29e1e6e00731c79e869bf0329af714ece5122b Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Wed, 11 Sep 2024 13:53:15 +0200
Subject: [PATCH 75/81] Fix the payday timing at the P6->P7 protocol update.

---
 CHANGELOG.md                                  |  1 +
 .../GlobalState/Persistent/BlockState.hs      | 14 +++++-------
 .../GlobalState/Persistent/PoolRewards.hs     | 22 +++++++++++++++++--
 3 files changed, 27 insertions(+), 10 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index e4d64172a..c999ae125 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -2,6 +2,7 @@
 
 ## Unreleased changes
 
+- Fix the timing of paydays after protocol update from version 6 to 7.
 - Improve consensus behaviour in the event of an unrecoverable exception.
 
 ## 7.0.1
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
index b04248360..49a924ea7 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
@@ -575,7 +575,9 @@ data BlockRewardDetails' (av :: AccountVersion) (bhv :: BlockHashVersion) where
 type BlockRewardDetails pv = BlockRewardDetails' (AccountVersionFor pv) (BlockHashVersionFor pv)
 
 -- | Migrate the block reward details.
---  When migrating to a 'P4' or later, this sets the 'nextPaydayEpoch' to the reward period length.
+--  When migrating to 'P4' or 'P5', or from 'P5' to 'P6', this sets the 'nextPaydayEpoch' to the
+--  reward period length. Migrations from 'P6' onwards (consensus protocol version 1) will set the
+--  'nextPaydayEpoch' to occur at the same time as it would have before the protocol update.
 migrateBlockRewardDetails ::
     forall t m oldpv pv.
     ( MonadBlobStore (t m),
@@ -600,11 +602,7 @@ migrateBlockRewardDetails StateMigrationParametersTrivial _ _ tp oldEpoch = \cas
             BlockRewardDetailsV1
                 <$> migrateHashedBufferedRef migratePR hbr
           where
-            rpLength = rewardPeriodEpochs _tpRewardPeriodLength
-            migratePR pr = migratePoolRewards nextPayday pr
-              where
-                oldPaydayEpoch = nextPaydayEpoch pr
-                nextPayday = max 1 (min rpLength (oldPaydayEpoch - oldEpoch))
+            migratePR = migratePoolRewardsP6 oldEpoch _tpRewardPeriodLength
         NoParam -> case protocolVersion @pv of {}
 migrateBlockRewardDetails StateMigrationParametersP1P2 _ _ _ _ = \case
     (BlockRewardDetailsV0 heb) -> BlockRewardDetailsV0 <$> migrateHashedEpochBlocks heb
@@ -623,10 +621,10 @@ migrateBlockRewardDetails StateMigrationParametersP5ToP6{} _ _ (SomeParam TimePa
     (BlockRewardDetailsV1 hbr) ->
         BlockRewardDetailsV1
             <$> migrateHashedBufferedRef (migratePoolRewards (rewardPeriodEpochs _tpRewardPeriodLength)) hbr
-migrateBlockRewardDetails StateMigrationParametersP6ToP7{} _ _ (SomeParam TimeParametersV1{..}) _ = \case
+migrateBlockRewardDetails StateMigrationParametersP6ToP7{} _ _ (SomeParam TimeParametersV1{..}) oldEpoch = \case
     (BlockRewardDetailsV1 hbr) ->
         BlockRewardDetailsV1
-            <$> migrateHashedBufferedRef (migratePoolRewards (rewardPeriodEpochs _tpRewardPeriodLength)) hbr
+            <$> migrateHashedBufferedRef (migratePoolRewardsP6 oldEpoch _tpRewardPeriodLength) hbr
 
 instance
     (MonadBlobStore m, IsBlockHashVersion bhv) =>
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/PoolRewards.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/PoolRewards.hs
index 53520bcab..61902188f 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/PoolRewards.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/PoolRewards.hs
@@ -17,6 +17,7 @@ module Concordium.GlobalState.Persistent.PoolRewards (
     lookupBakerCapitalAndRewardDetails,
     migratePoolRewardsP1,
     migratePoolRewards,
+    migratePoolRewardsP6,
 ) where
 
 import Control.Exception (assert)
@@ -67,7 +68,8 @@ data PoolRewards (bhv :: BlockHashVersion) = PoolRewards
 
 -- | Migrate pool rewards from @m@ to the new backing store @t m@.
 --  This takes the new next payday epoch as a parameter, since this should always be updated on
---  a protocol update. The hashes for the
+--  a protocol update. The hashes for the capital distributions are recomputed, as they schema
+--  may change between versions.
 migratePoolRewards ::
     (SupportMigration m t, IsBlockHashVersion bhv1) =>
     Epoch ->
@@ -77,6 +79,7 @@ migratePoolRewards newNextPayday PoolRewards{..} = do
     nextCapital' <- migrateHashedBufferedRef return nextCapital
     currentCapital' <- migrateHashedBufferedRef return currentCapital
     bakerPoolRewardDetails' <- LFMBT.migrateLFMBTree (migrateReference return) bakerPoolRewardDetails
+    -- the remaining fields are flat, so migration is copying
     return
         PoolRewards
             { nextCapital = nextCapital',
@@ -86,7 +89,22 @@ migratePoolRewards newNextPayday PoolRewards{..} = do
               ..
             }
 
--- the remaining fields are flat, so migration is copying
+-- | Migrate pool rewards from @m@ to the new backing store @t m@, for use with consensus version 1.
+--  This takes the pre-migration epoch number and reward period length as parameters, and sets the
+--  next payday epoch to be the the number of epochs that were remaining until the next payday
+--  at the time of the migration, or the length of the reward period if that is smaller.
+migratePoolRewardsP6 ::
+    (SupportMigration m t, IsBlockHashVersion bhv1) =>
+    -- | The epoch number before the migration.
+    Epoch ->
+    -- | The length of the reward period.
+    RewardPeriodLength ->
+    PoolRewards bhv0 ->
+    t m (PoolRewards bhv1)
+migratePoolRewardsP6 oldEpoch rpLength pr = migratePoolRewards newNextPayday pr
+  where
+    oldPaydayEpoch = nextPaydayEpoch pr
+    newNextPayday = max 1 (min (rewardPeriodEpochs rpLength) (oldPaydayEpoch - oldEpoch))
 
 -- | Migrate pool rewards from the format before delegation to the P4 format.
 migratePoolRewardsP1 ::

From b3527650d0ea089b447f054891bf486cf1c71691 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Wed, 11 Sep 2024 14:43:39 +0200
Subject: [PATCH 76/81] Address review comment

---
 concordium-consensus/src/Concordium/MultiVersion.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/concordium-consensus/src/Concordium/MultiVersion.hs b/concordium-consensus/src/Concordium/MultiVersion.hs
index c6848be56..bae8dc22e 100644
--- a/concordium-consensus/src/Concordium/MultiVersion.hs
+++ b/concordium-consensus/src/Concordium/MultiVersion.hs
@@ -518,7 +518,8 @@ data GlobalLockPoisonError = GlobalLockPoisonError
     deriving (Eq, Show, Typeable)
 
 instance Exception GlobalLockPoisonError where
-    displayException _ = "The global state lock was poisoned by an error in another thread."
+    displayException _ =
+        "The global state lock was poisoned by an unrecoverable error in another thread."
 
 -- | The context for managing multi-version consensus.
 data MultiVersionRunner finconf = MultiVersionRunner

From 772be2a0c7508552d0867684b1f060ca0dfbc776 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Wed, 11 Sep 2024 14:50:26 +0200
Subject: [PATCH 77/81] 7.0.2 release.

---
 CHANGELOG.md               | 2 ++
 concordium-node/Cargo.lock | 2 +-
 concordium-node/Cargo.toml | 2 +-
 3 files changed, 4 insertions(+), 2 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index c999ae125..ddd298754 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -2,6 +2,8 @@
 
 ## Unreleased changes
 
+## 7.0.2
+
 - Fix the timing of paydays after protocol update from version 6 to 7.
 - Improve consensus behaviour in the event of an unrecoverable exception.
 
diff --git a/concordium-node/Cargo.lock b/concordium-node/Cargo.lock
index 3e0e55898..0d3afd470 100644
--- a/concordium-node/Cargo.lock
+++ b/concordium-node/Cargo.lock
@@ -787,7 +787,7 @@ dependencies = [
 
 [[package]]
 name = "concordium_node"
-version = "7.0.1"
+version = "7.0.2"
 dependencies = [
  "anyhow",
  "app_dirs2",
diff --git a/concordium-node/Cargo.toml b/concordium-node/Cargo.toml
index fb1665939..bbe28e078 100644
--- a/concordium-node/Cargo.toml
+++ b/concordium-node/Cargo.toml
@@ -1,6 +1,6 @@
 [package]
 name = "concordium_node"
-version = "7.0.1" # must be kept in sync with 'is_compatible_version' in 'src/configuration.rs'
+version = "7.0.2" # must be kept in sync with 'is_compatible_version' in 'src/configuration.rs'
 description = "Concordium Node"
 authors = ["Concordium <developers@concordium.com>"]
 exclude = [".gitignore", ".gitlab-ci.yml", "test/**/*","**/**/.gitignore","**/**/.gitlab-ci.yml"]

From b1fd2f3b43f059006dd6f08f76158cf7d8680d08 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Thu, 12 Sep 2024 11:50:59 +0200
Subject: [PATCH 78/81] Fix issue where an error is thrown when the last
 finalized block is the genesis block after a state migration.

---
 .../src/Concordium/KonsensusV1/TreeState/StartUp.hs           | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/concordium-consensus/src/Concordium/KonsensusV1/TreeState/StartUp.hs b/concordium-consensus/src/Concordium/KonsensusV1/TreeState/StartUp.hs
index 577eb6f7a..24095714e 100644
--- a/concordium-consensus/src/Concordium/KonsensusV1/TreeState/StartUp.hs
+++ b/concordium-consensus/src/Concordium/KonsensusV1/TreeState/StartUp.hs
@@ -247,8 +247,8 @@ loadSkovData _genesisBlockHeight _runtimeParameters didRollback = do
             && not consensusIsShutdown
             then case mLatestFinEntry of
                 Nothing ->
-                    throwM . TreeStateInvariantViolation $
-                        "Missing finalization entry for last finalized block"
+                    -- In this case, by the above check, the last finalized block is the genesis block.
+                    return (blockEpoch lastFinBlock, Absent)
                 Just finEntry -> return (blockEpoch lastFinBlock + 1, Present finEntry)
             else return (blockEpoch lastFinBlock, Absent)
     chainParams <- getChainParameters $ bpState lastFinBlock

From f15c014d675eb47531421383011bc4555f728734 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Thu, 12 Sep 2024 15:48:33 +0200
Subject: [PATCH 79/81] Fix computation of regenesis block heights.

---
 concordium-consensus/src/Concordium/MultiVersion.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/concordium-consensus/src/Concordium/MultiVersion.hs b/concordium-consensus/src/Concordium/MultiVersion.hs
index bae8dc22e..3ee5f15b0 100644
--- a/concordium-consensus/src/Concordium/MultiVersion.hs
+++ b/concordium-consensus/src/Concordium/MultiVersion.hs
@@ -1314,7 +1314,7 @@ startupSkov genesis = do
                                 -- continue to the next iteration. If the state for the next
                                 -- configuration is missing, 'activateThis' is called which will
                                 -- activate the configuration and trigger the protocol update.
-                                loadLoop nextSPV activateThis (genIndex + 1) (fromIntegral lastFinalizedHeight + 1)
+                                loadLoop nextSPV activateThis (genIndex + 1) (lastFinalizedHeight + 1)
                     Nothing -> activateLast
             ConsensusV1 -> do
                 let !handlers = skovV1Handlers genIndex genHeight
@@ -1377,7 +1377,7 @@ startupSkov genesis = do
                                         nextSPV
                                         activateThis
                                         (genIndex + 1)
-                                        (fromIntegral esLastFinalizedHeight + 1)
+                                        (localToAbsoluteBlockHeight genHeight esLastFinalizedHeight + 1)
                             _ -> do
                                 -- This is still the current configuration (i.e. no protocol update
                                 -- has occurred, or the protocol update is not supported), so

From f2fae8fe528738610399fce7d005870e7e988929 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Thu, 12 Sep 2024 16:09:31 +0200
Subject: [PATCH 80/81] Update changelog. Bump version.

---
 CHANGELOG.md               | 6 ++++++
 concordium-node/Cargo.lock | 2 +-
 concordium-node/Cargo.toml | 2 +-
 3 files changed, 8 insertions(+), 2 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index ddd298754..b88ef5615 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -2,6 +2,12 @@
 
 ## Unreleased changes
 
+## 7.0.3
+
+- Fix a bug in the computation of the genesis height after the second protocol update. (#1237)
+- Fix a bug where an error was incorrectly thrown when loading the consenus state immediately
+  after a protocol update (in the new consensus version) (#1236).
+
 ## 7.0.2
 
 - Fix the timing of paydays after protocol update from version 6 to 7.
diff --git a/concordium-node/Cargo.lock b/concordium-node/Cargo.lock
index 0d3afd470..37a55117a 100644
--- a/concordium-node/Cargo.lock
+++ b/concordium-node/Cargo.lock
@@ -787,7 +787,7 @@ dependencies = [
 
 [[package]]
 name = "concordium_node"
-version = "7.0.2"
+version = "7.0.3"
 dependencies = [
  "anyhow",
  "app_dirs2",
diff --git a/concordium-node/Cargo.toml b/concordium-node/Cargo.toml
index bbe28e078..657d5753c 100644
--- a/concordium-node/Cargo.toml
+++ b/concordium-node/Cargo.toml
@@ -1,6 +1,6 @@
 [package]
 name = "concordium_node"
-version = "7.0.2" # must be kept in sync with 'is_compatible_version' in 'src/configuration.rs'
+version = "7.0.3" # must be kept in sync with 'is_compatible_version' in 'src/configuration.rs'
 description = "Concordium Node"
 authors = ["Concordium <developers@concordium.com>"]
 exclude = [".gitignore", ".gitlab-ci.yml", "test/**/*","**/**/.gitignore","**/**/.gitlab-ci.yml"]

From 0b33407a2648dc4e506fc3801a44ac38aa726253 Mon Sep 17 00:00:00 2001
From: Thomas Dinsdale-Young <ty@concordium.com>
Date: Fri, 13 Sep 2024 10:27:44 +0200
Subject: [PATCH 81/81] Fix base ref

---
 concordium-base            | 2 +-
 concordium-node/Cargo.lock | 4 ++--
 2 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/concordium-base b/concordium-base
index 72fd1f012..31a168d0a 160000
--- a/concordium-base
+++ b/concordium-base
@@ -1 +1 @@
-Subproject commit 72fd1f012a6d61a946ab7a458b043dff76dc5f23
+Subproject commit 31a168d0af2c568e8e6dd7931a404601b2cee090
diff --git a/concordium-node/Cargo.lock b/concordium-node/Cargo.lock
index 37a55117a..bdefe0cf9 100644
--- a/concordium-node/Cargo.lock
+++ b/concordium-node/Cargo.lock
@@ -699,7 +699,7 @@ dependencies = [
 
 [[package]]
 name = "concordium-smart-contract-engine"
-version = "5.0.0"
+version = "6.0.0"
 dependencies = [
  "anyhow",
  "byteorder",
@@ -721,7 +721,7 @@ dependencies = [
 
 [[package]]
 name = "concordium-wasm"
-version = "4.0.0"
+version = "5.0.0"
 dependencies = [
  "anyhow",
  "concordium-contracts-common",