{-# LANGUAGE StrictData #-}
module Bitcoin.Address.SegWit
  ( -- * Version
    Version
  , version
  , unVersion
  , versionOp
  , version0
    -- * Programs
  , Program
  , program
  , programVersion
  , programData
  , renderProgram
    -- ** Standard programs
  , p2wpkh
  , p2wsh
  ) where

import qualified Codec.Binary.Bech32 as Bech32
import qualified Codec.Binary.Bech32.Internal as Bech32
import Control.Monad
import qualified Data.Bitcoin.Script as S
import qualified Data.ByteString as B
import qualified Data.ByteString.Builder as BB
import qualified Data.ByteString.Lazy.Char8 as BL8
import qualified Data.Text.Encoding as T
import Data.Word

import Bitcoin.Address.Hash
import Bitcoin.Address.Internal (op0to16)
import Bitcoin.Address.Settings

--------------------------------------------------------------------------------

-- | A SegWit program. Construct with 'program'.
data Program = Program Version B.ByteString
  deriving (Program -> Program -> Bool
(Program -> Program -> Bool)
-> (Program -> Program -> Bool) -> Eq Program
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Program -> Program -> Bool
$c/= :: Program -> Program -> Bool
== :: Program -> Program -> Bool
$c== :: Program -> Program -> Bool
Eq, Eq Program
Eq Program =>
(Program -> Program -> Ordering)
-> (Program -> Program -> Bool)
-> (Program -> Program -> Bool)
-> (Program -> Program -> Bool)
-> (Program -> Program -> Bool)
-> (Program -> Program -> Program)
-> (Program -> Program -> Program)
-> Ord Program
Program -> Program -> Bool
Program -> Program -> Ordering
Program -> Program -> Program
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 :: Program -> Program -> Program
$cmin :: Program -> Program -> Program
max :: Program -> Program -> Program
$cmax :: Program -> Program -> Program
>= :: Program -> Program -> Bool
$c>= :: Program -> Program -> Bool
> :: Program -> Program -> Bool
$c> :: Program -> Program -> Bool
<= :: Program -> Program -> Bool
$c<= :: Program -> Program -> Bool
< :: Program -> Program -> Bool
$c< :: Program -> Program -> Bool
compare :: Program -> Program -> Ordering
$ccompare :: Program -> Program -> Ordering
$cp1Ord :: Eq Program
Ord)

-- | Version and base-16 encoded program data.
instance Show Program where
  showsPrec :: Int -> Program -> ShowS
showsPrec n :: Int
n (Program v :: Version
v d :: ByteString
d) = Bool -> ShowS -> ShowS
showParen (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    String -> ShowS
showString "Program " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    String -> ShowS
forall a. Monoid a => a -> a -> a
mappend (Version -> String
forall a. Show a => a -> String
show Version
v) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    String -> ShowS
forall a. Monoid a => a -> a -> a
mappend " " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    String -> ShowS
forall a. Monoid a => a -> a -> a
mappend (ByteString -> String
BL8.unpack (Builder -> ByteString
BB.toLazyByteString (ByteString -> Builder
BB.byteStringHex ByteString
d)))

-- | SegWit program version.
programVersion :: Program -> Version
{-# INLINE programVersion #-}
programVersion :: Program -> Version
programVersion (Program v :: Version
v _) = Version
v

-- | Raw SegWit program data.
programData :: Program -> B.ByteString
{-# INLINE programData #-}
programData :: Program -> ByteString
programData (Program _ x :: ByteString
x) = ByteString
x

-- | Construct a 'Program' from its raw bytes.
--
-- __WARINING__ This function will prevent you frow constructing invalid SegWit
-- programs, but won't help you write __meaningful__ programs. Prefer to use
-- safe constructions such as 'p2wpkh' or 'p2wsh' instead.
program
  :: Version
  -> B.ByteString  -- ^ Raw SegWit program bytes.
  -> Maybe Program -- ^ Nothing if program length is invalid for version.
program :: Version -> ByteString -> Maybe Program
program ver :: Version
ver prog :: ByteString
prog = do
  let len :: Int
len = ByteString -> Int
B.length ByteString
prog
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ case Version -> Word8
unVersion Version
ver of
     0 -> Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 20 Bool -> Bool -> Bool
|| Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 32
     _ -> Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 2  Bool -> Bool -> Bool
&& Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 40
  Program -> Maybe Program
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Version -> ByteString -> Program
Program Version
ver ByteString
prog)

--------------------------------------------------------------------------------

-- | Bech32-encode a 'Program'.
renderProgram :: PrefixSegWit -> Program -> B.ByteString
{-# INLINE renderProgram #-}
renderProgram :: PrefixSegWit -> Program -> ByteString
renderProgram pre :: PrefixSegWit
pre (Program ver :: Version
ver prog :: ByteString
prog) =
  let w5ver :: Word5
w5ver = Int -> Word5
forall a. Enum a => Int -> a
toEnum (Int -> Word5) -> Int -> Word5
forall a b. (a -> b) -> a -> b
$ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Word8 -> Int
forall a b. (a -> b) -> a -> b
$ Version -> Word8
unVersion Version
ver
      dver :: DataPart
dver  = [Word5] -> DataPart
Bech32.dataPartFromWords [Word5
w5ver]
      dprog :: DataPart
dprog = ByteString -> DataPart
Bech32.dataPartFromBytes ByteString
prog
  in Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ HumanReadablePart -> DataPart -> Text
Bech32.encodeLenient (PrefixSegWit -> HumanReadablePart
prefixSegWitHRP PrefixSegWit
pre) (DataPart
dver DataPart -> DataPart -> DataPart
forall a. Semigroup a => a -> a -> a
<> DataPart
dprog)

--------------------------------------------------------------------------------

-- | The version for of a SegWit 'Program'.
newtype Version = Version Word8
  deriving (Version -> Version -> Bool
(Version -> Version -> Bool)
-> (Version -> Version -> Bool) -> Eq Version
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Version -> Version -> Bool
$c/= :: Version -> Version -> Bool
== :: Version -> Version -> Bool
$c== :: Version -> Version -> Bool
Eq, Eq Version
Eq Version =>
(Version -> Version -> Ordering)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Version)
-> (Version -> Version -> Version)
-> Ord Version
Version -> Version -> Bool
Version -> Version -> Ordering
Version -> Version -> Version
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 :: Version -> Version -> Version
$cmin :: Version -> Version -> Version
max :: Version -> Version -> Version
$cmax :: Version -> Version -> Version
>= :: Version -> Version -> Bool
$c>= :: Version -> Version -> Bool
> :: Version -> Version -> Bool
$c> :: Version -> Version -> Bool
<= :: Version -> Version -> Bool
$c<= :: Version -> Version -> Bool
< :: Version -> Version -> Bool
$c< :: Version -> Version -> Bool
compare :: Version -> Version -> Ordering
$ccompare :: Version -> Version -> Ordering
$cp1Ord :: Eq Version
Ord, Int -> Version -> ShowS
[Version] -> ShowS
Version -> String
(Int -> Version -> ShowS)
-> (Version -> String) -> ([Version] -> ShowS) -> Show Version
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Version] -> ShowS
$cshowList :: [Version] -> ShowS
show :: Version -> String
$cshow :: Version -> String
showsPrec :: Int -> Version -> ShowS
$cshowsPrec :: Int -> Version -> ShowS
Show)

-- | Construct a SegWit 'Version'.
--
-- The given 'Word8' must be in the inclusive range [0 … 16].
version :: Word8 -> Maybe Version
{-# INLINE version #-}
version :: Word8 -> Maybe Version
version w :: Word8
w = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= 16)
  Version -> Maybe Version
forall a. a -> Maybe a
Just (Word8 -> Version
Version Word8
w)

-- | The obtained 'Word8' is in the inclusive range [0 … 16].
unVersion :: Version -> Word8
{-# INLINE unVersion #-}
unVersion :: Version -> Word8
unVersion (Version w :: Word8
w) = Word8
w

-- | The 'S.ScriptOp' corresponding to the 'Version', in
-- range ['S.OP_0' … 'S.OP_16']
versionOp :: Version -> S.ScriptOp
{-# INLINE versionOp #-}
versionOp :: Version -> ScriptOp
versionOp (Version w :: Word8
w) = case Int -> Maybe ScriptOp
op0to16 (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w) of
  Just op :: ScriptOp
op -> ScriptOp
op
  Nothing -> ScriptOp
forall a. HasCallStack => a
undefined -- impossible

--------------------------------------------------------------------------------

-- | SegWit version 0
version0 :: Version
{-# INLINE version0 #-}
Just version0 :: Version
version0 = Word8 -> Maybe Version
version 0

-- | Construct a standard SegWit version 0 P2WPKH program.
p2wpkh :: PubHash160 -> Program
{-# INLINE p2wpkh #-}
p2wpkh :: PubHash160 -> Program
p2wpkh pkh :: PubHash160
pkh = case Version -> ByteString -> Maybe Program
program Version
version0 (PubHash160 -> ByteString
unPubHash160 PubHash160
pkh) of
  Just prog :: Program
prog -> Program
prog
  Nothing   -> Program
forall a. HasCallStack => a
undefined -- impossible

-- | Construct a standard SegWit version 0 P2WSH program.
p2wsh :: ScriptSHA256 -> Program
{-# INLINE p2wsh #-}
p2wsh :: ScriptSHA256 -> Program
p2wsh sh :: ScriptSHA256
sh = case Version -> ByteString -> Maybe Program
program Version
version0 (ScriptSHA256 -> ByteString
unScriptSHA256 ScriptSHA256
sh) of
  Just prog :: Program
prog -> Program
prog
  Nothing   -> Program
forall a. HasCallStack => a
undefined -- impossible