{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

module ElectrsClient.Rpc
  ( getBalance,
    version,
    blockHeader,
    Balance (..),
    ScriptHash (..),
    BlockHeader (..),
  )
where

import Data.Aeson (decode, encode, withObject, (.:))
import qualified Data.ByteString.Lazy as BS
import qualified Data.Digest.Pure.SHA as SHA
import ElectrsClient.Client as Client
import ElectrsClient.Data.Env
import ElectrsClient.Import.External
import ElectrsClient.RpcRequest as Req
import ElectrsClient.RpcResponse as Resp
import ElectrsClient.Type
import qualified Network.Bitcoin.Wallet as BtcW
import qualified Text.Hex as TH

newtype ScriptHash = ScriptHash Text
  deriving stock ((forall x. ScriptHash -> Rep ScriptHash x)
-> (forall x. Rep ScriptHash x -> ScriptHash) -> Generic ScriptHash
forall x. Rep ScriptHash x -> ScriptHash
forall x. ScriptHash -> Rep ScriptHash x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ScriptHash x -> ScriptHash
$cfrom :: forall x. ScriptHash -> Rep ScriptHash x
Generic)

newtype BlockHeader = BlockHeader Text
  deriving newtype (BlockHeader -> BlockHeader -> Bool
(BlockHeader -> BlockHeader -> Bool)
-> (BlockHeader -> BlockHeader -> Bool) -> Eq BlockHeader
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlockHeader -> BlockHeader -> Bool
$c/= :: BlockHeader -> BlockHeader -> Bool
== :: BlockHeader -> BlockHeader -> Bool
$c== :: BlockHeader -> BlockHeader -> Bool
Eq)
  deriving stock ((forall x. BlockHeader -> Rep BlockHeader x)
-> (forall x. Rep BlockHeader x -> BlockHeader)
-> Generic BlockHeader
forall x. Rep BlockHeader x -> BlockHeader
forall x. BlockHeader -> Rep BlockHeader x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BlockHeader x -> BlockHeader
$cfrom :: forall x. BlockHeader -> Rep BlockHeader x
Generic)

instance Out BlockHeader

newtype MSat = MSat Word64
  deriving newtype
    ( MSat -> MSat -> Bool
(MSat -> MSat -> Bool) -> (MSat -> MSat -> Bool) -> Eq MSat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MSat -> MSat -> Bool
$c/= :: MSat -> MSat -> Bool
== :: MSat -> MSat -> Bool
$c== :: MSat -> MSat -> Bool
Eq,
      Integer -> MSat
MSat -> MSat
MSat -> MSat -> MSat
(MSat -> MSat -> MSat)
-> (MSat -> MSat -> MSat)
-> (MSat -> MSat -> MSat)
-> (MSat -> MSat)
-> (MSat -> MSat)
-> (MSat -> MSat)
-> (Integer -> MSat)
-> Num MSat
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> MSat
$cfromInteger :: Integer -> MSat
signum :: MSat -> MSat
$csignum :: MSat -> MSat
abs :: MSat -> MSat
$cabs :: MSat -> MSat
negate :: MSat -> MSat
$cnegate :: MSat -> MSat
* :: MSat -> MSat -> MSat
$c* :: MSat -> MSat -> MSat
- :: MSat -> MSat -> MSat
$c- :: MSat -> MSat -> MSat
+ :: MSat -> MSat -> MSat
$c+ :: MSat -> MSat -> MSat
Num,
      Eq MSat
Eq MSat
-> (MSat -> MSat -> Ordering)
-> (MSat -> MSat -> Bool)
-> (MSat -> MSat -> Bool)
-> (MSat -> MSat -> Bool)
-> (MSat -> MSat -> Bool)
-> (MSat -> MSat -> MSat)
-> (MSat -> MSat -> MSat)
-> Ord MSat
MSat -> MSat -> Bool
MSat -> MSat -> Ordering
MSat -> MSat -> MSat
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MSat -> MSat -> MSat
$cmin :: MSat -> MSat -> MSat
max :: MSat -> MSat -> MSat
$cmax :: MSat -> MSat -> MSat
>= :: MSat -> MSat -> Bool
$c>= :: MSat -> MSat -> Bool
> :: MSat -> MSat -> Bool
$c> :: MSat -> MSat -> Bool
<= :: MSat -> MSat -> Bool
$c<= :: MSat -> MSat -> Bool
< :: MSat -> MSat -> Bool
$c< :: MSat -> MSat -> Bool
compare :: MSat -> MSat -> Ordering
$ccompare :: MSat -> MSat -> Ordering
Ord,
      Value -> Parser [MSat]
Value -> Parser MSat
(Value -> Parser MSat) -> (Value -> Parser [MSat]) -> FromJSON MSat
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [MSat]
$cparseJSONList :: Value -> Parser [MSat]
parseJSON :: Value -> Parser MSat
$cparseJSON :: Value -> Parser MSat
FromJSON,
      Int -> MSat -> ShowS
[MSat] -> ShowS
MSat -> String
(Int -> MSat -> ShowS)
-> (MSat -> String) -> ([MSat] -> ShowS) -> Show MSat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MSat] -> ShowS
$cshowList :: [MSat] -> ShowS
show :: MSat -> String
$cshow :: MSat -> String
showsPrec :: Int -> MSat -> ShowS
$cshowsPrec :: Int -> MSat -> ShowS
Show,
      ReadPrec [MSat]
ReadPrec MSat
Int -> ReadS MSat
ReadS [MSat]
(Int -> ReadS MSat)
-> ReadS [MSat] -> ReadPrec MSat -> ReadPrec [MSat] -> Read MSat
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MSat]
$creadListPrec :: ReadPrec [MSat]
readPrec :: ReadPrec MSat
$creadPrec :: ReadPrec MSat
readList :: ReadS [MSat]
$creadList :: ReadS [MSat]
readsPrec :: Int -> ReadS MSat
$creadsPrec :: Int -> ReadS MSat
Read
    )
  deriving stock
    ( (forall x. MSat -> Rep MSat x)
-> (forall x. Rep MSat x -> MSat) -> Generic MSat
forall x. Rep MSat x -> MSat
forall x. MSat -> Rep MSat x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MSat x -> MSat
$cfrom :: forall x. MSat -> Rep MSat x
Generic
    )

instance Out MSat

data Balance = Balance
  { Balance -> MSat
confirmed :: MSat,
    Balance -> MSat
unconfirmed :: MSat
  }
  deriving stock ((forall x. Balance -> Rep Balance x)
-> (forall x. Rep Balance x -> Balance) -> Generic Balance
forall x. Rep Balance x -> Balance
forall x. Balance -> Rep Balance x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Balance x -> Balance
$cfrom :: forall x. Balance -> Rep Balance x
Generic, Int -> Balance -> ShowS
[Balance] -> ShowS
Balance -> String
(Int -> Balance -> ShowS)
-> (Balance -> String) -> ([Balance] -> ShowS) -> Show Balance
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Balance] -> ShowS
$cshowList :: [Balance] -> ShowS
show :: Balance -> String
$cshow :: Balance -> String
showsPrec :: Int -> Balance -> ShowS
$cshowsPrec :: Int -> Balance -> ShowS
Show)

getBalanceFromSat :: MSat -> MSat -> Balance
getBalanceFromSat :: MSat -> MSat -> Balance
getBalanceFromSat MSat
c MSat
u = MSat -> MSat -> Balance
Balance (MSat
c MSat -> MSat -> MSat
forall a. Num a => a -> a -> a
* MSat
1000) (MSat
u MSat -> MSat -> MSat
forall a. Num a => a -> a -> a
* MSat
1000)

instance FromJSON Balance where
  parseJSON :: Value -> Parser Balance
parseJSON = String -> (Object -> Parser Balance) -> Value -> Parser Balance
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Balance" ((Object -> Parser Balance) -> Value -> Parser Balance)
-> (Object -> Parser Balance) -> Value -> Parser Balance
forall a b. (a -> b) -> a -> b
$ \Object
v ->
    MSat -> MSat -> Balance
getBalanceFromSat
      (MSat -> MSat -> Balance)
-> Parser MSat -> Parser (MSat -> Balance)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser MSat
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"confirmed"
      Parser (MSat -> Balance) -> Parser MSat -> Parser Balance
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser MSat
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"unconfirmed"

instance ToJSON ScriptHash

instance FromJSON BlockHeader

instance Out Balance

callRpc :: (MonadUnliftIO m, ToJSON req, FromJSON resp) => Method -> req -> ElectrsEnv -> m (Either RpcError resp)
callRpc :: forall (m :: * -> *) req resp.
(MonadUnliftIO m, ToJSON req, FromJSON resp) =>
Method -> req -> ElectrsEnv -> m (Either RpcError resp)
callRpc Method
m req
r ElectrsEnv
env = do
  let request :: RpcRequest req
request =
        RpcRequest :: forall a. Integer -> Text -> Method -> a -> RpcRequest a
RpcRequest
          { id :: Integer
Req.id = Integer
0,
            jsonrpc :: Text
Req.jsonrpc = Text
"2.0",
            method :: Method
Req.method = Method
m,
            params :: req
Req.params = req
r
          }
  Either RpcError ByteString
msgReply <- ByteString -> ElectrsEnv -> m (Either RpcError ByteString)
forall (m :: * -> *).
MonadUnliftIO m =>
ByteString -> ElectrsEnv -> m (Either RpcError ByteString)
Client.send (RpcRequest req -> ByteString
forall req. ToJSON req => RpcRequest req -> ByteString
lazyEncode RpcRequest req
request) ElectrsEnv
env
  Either RpcError resp -> m (Either RpcError resp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RpcError resp -> m (Either RpcError resp))
-> Either RpcError resp -> m (Either RpcError resp)
forall a b. (a -> b) -> a -> b
$ Either RpcError (Either RpcError resp) -> Either RpcError resp
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Either RpcError (Either RpcError resp) -> Either RpcError resp)
-> Either RpcError (Either RpcError resp) -> Either RpcError resp
forall a b. (a -> b) -> a -> b
$ (ByteString -> Either RpcError resp)
-> Either RpcError ByteString
-> Either RpcError (Either RpcError resp)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((RpcResponse resp -> resp)
-> Either RpcError (RpcResponse resp) -> Either RpcError resp
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second RpcResponse resp -> resp
forall a. RpcResponse a -> a
result (Either RpcError (RpcResponse resp) -> Either RpcError resp)
-> (ByteString -> Either RpcError (RpcResponse resp))
-> ByteString
-> Either RpcError resp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either RpcError (RpcResponse resp)
forall resp. FromJSON resp => ByteString -> Either RpcError resp
lazyDecode) Either RpcError ByteString
msgReply
  where
    lazyDecode :: FromJSON resp => ByteString -> Either RpcError resp
    lazyDecode :: forall resp. FromJSON resp => ByteString -> Either RpcError resp
lazyDecode = RpcError -> Maybe resp -> Either RpcError resp
forall l r. l -> Maybe r -> Either l r
maybeToRight RpcError
RpcJsonDecodeError (Maybe resp -> Either RpcError resp)
-> (ByteString -> Maybe resp) -> ByteString -> Either RpcError resp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe resp
forall a. FromJSON a => ByteString -> Maybe a
decode (ByteString -> Maybe resp)
-> (ByteString -> ByteString) -> ByteString -> Maybe resp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BS.fromStrict
    lazyEncode :: ToJSON req => RpcRequest req -> ByteString
    lazyEncode :: forall req. ToJSON req => RpcRequest req -> ByteString
lazyEncode = ByteString -> ByteString
BS.toStrict (ByteString -> ByteString)
-> (RpcRequest req -> ByteString) -> RpcRequest req -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RpcRequest req -> ByteString
forall a. ToJSON a => a -> ByteString
encode

version :: MonadUnliftIO m => ElectrsEnv -> () -> m (Either RpcError [Text])
version :: forall (m :: * -> *).
MonadUnliftIO m =>
ElectrsEnv -> () -> m (Either RpcError [Text])
version ElectrsEnv
env () = Method -> [Text] -> ElectrsEnv -> m (Either RpcError [Text])
forall (m :: * -> *) req resp.
(MonadUnliftIO m, ToJSON req, FromJSON resp) =>
Method -> req -> ElectrsEnv -> m (Either RpcError resp)
callRpc Method
Version [Text
"" :: Text, Text
"1.4" :: Text] ElectrsEnv
env

getBalance :: MonadUnliftIO m => ElectrsEnv -> BitcoindEnv -> Either (OnChainAddress a) ScriptHash -> m (Either RpcError Balance)
getBalance :: forall (m :: * -> *) (a :: MoneyRelation).
MonadUnliftIO m =>
ElectrsEnv
-> BitcoindEnv
-> Either (OnChainAddress a) ScriptHash
-> m (Either RpcError Balance)
getBalance ElectrsEnv
env BitcoindEnv
_ (Right ScriptHash
scriptHash) = Method -> [ScriptHash] -> ElectrsEnv -> m (Either RpcError Balance)
forall (m :: * -> *) req resp.
(MonadUnliftIO m, ToJSON req, FromJSON resp) =>
Method -> req -> ElectrsEnv -> m (Either RpcError resp)
callRpc Method
GetBalance [ScriptHash
scriptHash] ElectrsEnv
env
getBalance ElectrsEnv
env BitcoindEnv
bEnv (Left OnChainAddress a
address) = do
  Either RpcError ScriptHash
scrHash <- BitcoindEnv -> OnChainAddress a -> m (Either RpcError ScriptHash)
forall (m :: * -> *) (a :: MoneyRelation).
MonadUnliftIO m =>
BitcoindEnv -> OnChainAddress a -> m (Either RpcError ScriptHash)
getScriptHash BitcoindEnv
bEnv OnChainAddress a
address
  case Either RpcError ScriptHash
scrHash of
    Right ScriptHash
sh -> ElectrsEnv
-> BitcoindEnv
-> Either (OnChainAddress Any) ScriptHash
-> m (Either RpcError Balance)
forall (m :: * -> *) (a :: MoneyRelation).
MonadUnliftIO m =>
ElectrsEnv
-> BitcoindEnv
-> Either (OnChainAddress a) ScriptHash
-> m (Either RpcError Balance)
getBalance ElectrsEnv
env BitcoindEnv
bEnv (ScriptHash -> Either (OnChainAddress Any) ScriptHash
forall a b. b -> Either a b
Right ScriptHash
sh)
    Left RpcError
_ -> Either RpcError Balance -> m (Either RpcError Balance)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RpcError Balance -> m (Either RpcError Balance))
-> Either RpcError Balance -> m (Either RpcError Balance)
forall a b. (a -> b) -> a -> b
$ RpcError -> Either RpcError Balance
forall a b. a -> Either a b
Left (Text -> RpcError
OtherError Text
"Getting ScriptHash error")

blockHeader :: MonadUnliftIO m => ElectrsEnv -> BlkHeight -> m (Either RpcError BlockHeader)
blockHeader :: forall (m :: * -> *).
MonadUnliftIO m =>
ElectrsEnv -> BlkHeight -> m (Either RpcError BlockHeader)
blockHeader ElectrsEnv
env BlkHeight
bh = Method
-> [BlkHeight] -> ElectrsEnv -> m (Either RpcError BlockHeader)
forall (m :: * -> *) req resp.
(MonadUnliftIO m, ToJSON req, FromJSON resp) =>
Method -> req -> ElectrsEnv -> m (Either RpcError resp)
callRpc Method
GetBlockHeader [BlkHeight
bh] ElectrsEnv
env

getScriptHash :: (MonadUnliftIO m) => BitcoindEnv -> OnChainAddress a -> m (Either RpcError ScriptHash)
getScriptHash :: forall (m :: * -> *) (a :: MoneyRelation).
MonadUnliftIO m =>
BitcoindEnv -> OnChainAddress a -> m (Either RpcError ScriptHash)
getScriptHash BitcoindEnv
bEnv OnChainAddress a
addr = ExceptT RpcError m ScriptHash -> m (Either RpcError ScriptHash)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT RpcError m ScriptHash -> m (Either RpcError ScriptHash))
-> ExceptT RpcError m ScriptHash -> m (Either RpcError ScriptHash)
forall a b. (a -> b) -> a -> b
$ do
  Client
btcClient <-
    IO Client -> ExceptT RpcError m Client
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Client -> ExceptT RpcError m Client)
-> IO Client -> ExceptT RpcError m Client
forall a b. (a -> b) -> a -> b
$
      String -> ByteString -> ByteString -> IO Client
BtcW.getClient
        (Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ BitcoindEnv -> Text
bitcoindEnvHost BitcoindEnv
bEnv)
        (Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ BitcoindEnv -> Text
bitcoindEnvUsername BitcoindEnv
bEnv)
        (Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ BitcoindEnv -> Text
bitcoindEnvPassword BitcoindEnv
bEnv)

  BtcW.AddrInfo Text
_ ScrPubKey
sp Bool
_ Bool
_ <- IO AddrInfo -> ExceptT RpcError m AddrInfo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AddrInfo -> ExceptT RpcError m AddrInfo)
-> IO AddrInfo -> ExceptT RpcError m AddrInfo
forall a b. (a -> b) -> a -> b
$ Client -> Text -> IO AddrInfo
BtcW.getAddrInfo Client
btcClient (OnChainAddress a -> Text
coerce OnChainAddress a
addr)
  ScrPubKey -> ExceptT RpcError m ScriptHash
forall (m :: * -> *).
MonadUnliftIO m =>
ScrPubKey -> ExceptT RpcError m ScriptHash
decodeSp ScrPubKey
sp
  where
    decodeSp :: (MonadUnliftIO m) => BtcW.ScrPubKey -> ExceptT RpcError m ScriptHash
    decodeSp :: forall (m :: * -> *).
MonadUnliftIO m =>
ScrPubKey -> ExceptT RpcError m ScriptHash
decodeSp =
      m (Either RpcError ScriptHash) -> ExceptT RpcError m ScriptHash
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT
        (m (Either RpcError ScriptHash) -> ExceptT RpcError m ScriptHash)
-> (ScrPubKey -> m (Either RpcError ScriptHash))
-> ScrPubKey
-> ExceptT RpcError m ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either RpcError ScriptHash -> m (Either RpcError ScriptHash)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (Either RpcError ScriptHash -> m (Either RpcError ScriptHash))
-> (ScrPubKey -> Either RpcError ScriptHash)
-> ScrPubKey
-> m (Either RpcError ScriptHash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ScriptHash)
-> Either RpcError ByteString -> Either RpcError ScriptHash
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ByteString -> ScriptHash
sha256AndReverse
        (Either RpcError ByteString -> Either RpcError ScriptHash)
-> (ScrPubKey -> Either RpcError ByteString)
-> ScrPubKey
-> Either RpcError ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RpcError -> Maybe ByteString -> Either RpcError ByteString
forall l r. l -> Maybe r -> Either l r
maybeToRight RpcError
RpcHexDecodeError
        (Maybe ByteString -> Either RpcError ByteString)
-> (ScrPubKey -> Maybe ByteString)
-> ScrPubKey
-> Either RpcError ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe ByteString
TH.decodeHex
        (Text -> Maybe ByteString)
-> (ScrPubKey -> Text) -> ScrPubKey -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScrPubKey -> Text
coerce
    sha256AndReverse :: ByteString -> ScriptHash
sha256AndReverse =
      Text -> ScriptHash
ScriptHash
        (Text -> ScriptHash)
-> (ByteString -> Text) -> ByteString -> ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
TH.encodeHex
        (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BS.toStrict
        (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BS.reverse
        (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest SHA256State -> ByteString
forall t. Digest t -> ByteString
SHA.bytestringDigest
        (Digest SHA256State -> ByteString)
-> (ByteString -> Digest SHA256State) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Digest SHA256State
SHA.sha256
        (ByteString -> Digest SHA256State)
-> (ByteString -> ByteString) -> ByteString -> Digest SHA256State
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BS.fromStrict